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SUMMARY 


The  mathematical  modeling  techniques  used  to  predict 
atmospheric  dispersion  of  heavier- than* air  gases  discussed  in 
Volume  I  of  this  report  are  briefly  summarized;  these 
techniques  are  incorporated  in  an  interactive  computer  model 
DEGADIS . 

The  necessary  input  information  to  simulate  a  heavier- than- 
air  gas  release  is  summarized.  Example  simulations  of  a  steady 
state  and  transient  release  are  included.  Guidelines  for 
installation  of  DEGADIS  are  included,  and  a  listing  of  DEGADIS 
is  included  along  with  a  partial  list  of  program  variables. 


I.  DEGADIS  MODEL  SUMMARY 


The  DEGADIS  model  mechods,  equations,  and  supporting  data 
are  described  in  detail  in  Volume  I  of  this  report.  This 
section  is  intended  to  summarize  the  critical  components  of  the 
model  formulation  and  the  associated  limitations,  and  to 
indicate  cautions  and  diagnostic  guidelines  which  should  be 
followed  in  its  use.  The  suggested  limitations  and  guidelines 
are  based  on  the  experience  gained  during  the  development  of 
the  model  and  its  verification  by  comparison  with  a  wide  range 
of  heavier -than* air  gas  dispersion  tests.  These  limitations 
and  precautions  will  almost  certainly  be  refined  through 
further  application  of  the  model. 

1.1.  Summary  Description 

The  DEGADIS  model  combines  the  principal  features  of  the 
Shell  HEGADAS  model  (Colenbrander ,  1980,  and  Colenbrander  and 
Puttock,  1983)  and  a  box  model  proposed  by  van  Ulden  (1983). 
DEGADIS  incorporates  some  features  not  contained  in  either  of 
the  original  models  and  substitutes  methods  which  we  believe 
are  more  appropriate  for  treatment  of  other  features.  The 
general  application  of  the  model  involves  formation  of  a 
"secondary"  gas  source,  the  subsequent  entrainment  of  gas  from 
that  secondary  source  by  the  wind  field,  and  downwind 
dispersion  of  the  gas  plume  or  cloud.  Figure  1.1  illustrates 
the  general  methodology;  the  description  of  the  formation  and 
development  of  the  secondary  source  utilizes  the  box  model,  and 
the  entrainment  from  the  secondary  source  and  subsequent 
downwind  dispersion  utilizes  the  similarity  representations  of 
the  cloud  concentration  and  vertical  velocity  profiles  of  the 
HEGADAS  model.  Heavier- than- air  gas  releases  which  cannnot  be 
represented  as  steady,  continuous  releases  are  modeled  as  a 
series  of  pseudo-steady  releases. 

Application  of  the  model  to  releases  of  a  heavier- than-air 
gas  in  zero  wind  involves  only  the  box  model.  The  box  model 
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Figure  1.1.  Schematic  diagram  of  DEGADIS  model 
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treatment  of  gravity  spreading  and  associated  air  entrainment 
is  based  on  parameterization  of  the  laboratory  still-air 
experiments  described  in  Volume  II  of  this  report.  For 
releases  in  wind,  the  box  model  also  describes  the  source 
development  but  provides  for  entrainment  of  the  gas -air  source 
cloud  by  the  action  of  the  wind.  The  rate  of  release  relative 
to  the  wind  velocity  determines  the  important  characteristics 
of  the  cloud  dispersion  process.  For  high  rates  of  release 
(instantaneous  being  the  most  rapid)  in  low  wind,  the  buoyancy - 
dominated  flow  processes  described  by  the  box  model  predominate 
and  may  essentially  determine  downwind  distances  for  dilution 
of  the  gas  cloud  to  the  1-10%  gas  concentration  levels  which 
characterize  the  lower  flammability  limit  for  light 
hydrocarbons.  Conversely,  for  low  rates  of  release  in  high 
winds,  the  rate  of  entrainment  due  to  gravity  spreading  is  not 
very  important,  and  the  downwind  dispersion  process  is 
controlled  primarily  by  the  vertical  dispersion  produced  by  the 
action  of  the  wind  field  shear  in  the  cloud.  The  treatment  of 
the  large  range  of  "intermediate"  conditions  (i.e.  where 
gravity  spreading  and  air  entrainment  by  the  secondary  source 
importantly  influence  the  source  cloud  concentration  and 
dimensions,  and  consequently  the  "initial  condition"  for 
downwind  dispersion  calculation)  distinguishes  the  DEGADIS 


mode 1 . 


DEGADIS  incorporates  heat  transfer  and  water  transfer  when 
applicable  from  the  underlying  surface  to  the  cloud.  Inclusion 
of  these  procedures  in  the  model  is  optional.  Effects  of  heat 
transfer  on  both  the  mean  cloud  buoyancy  and  the  vertical 
turbulent  mixing  (air  entrainment)  are  included  while  direct 
effect  of  water  transfer  is  included  only  in  the  mean  cloud 
buoyancy . 

DEGADIS  is  written  in  Digital  Equipment  Corporation's 
VAX/VMS*  Fortran  (a  superset  of  ANSI  Fortran  77);  it  is 


*VaX  and  VMS  are  registered  trademarks  of  Digital  Equipment 
Corporation. 


composed  of  five  programs  which  communicate  using  ASCII  files 
(see  Section  II).  A  listing  of  the  code  is  included  as 
Appendix  C,  and  a  partial  list  of  program  variables  is  given  in 
Appendix  E.  Considerations  for  installation  of  DEGADIS  are 
discussed  in  Appendices  A  and  B.  DEGADIS  self -diagnostics  are 
listed  in  Appendix  D  along  with  suggested  actions. 

1.2.  Model  Limitations  and  Cautions 

DEGADIS  model  application  should  be  limited  to  the 
description  of  atmospheric  dispersion  of  heavier- than-air  gas 
releases  at  ground  level  onto  flat,  unobstructed  terrain  or 
water.  Application  to  releases  from  sources  above  ground  level 
(e.g.  overflow  from  dikes)  would  be  expected  to  give 
conservative  predictions  of  the  downwind  hazard  zones ,  but  this 
has  not  been  verified. 

The  dispersion  of  a  heavier- than-air  gas  by  the  action  of 
the  wind  assumes  the  maintenance  of  a  wind  velocity  profile  in 
the  gas  cloud  or  plume  whose  characteristics  are  determined  by 
the  approach  wind  flow  (upwind  of  the  release) .  The  treatment 
of  vertical  momentum  transfer  Invokes  the  assumption  of  a 
logarithmic  vertical  velocity  profile,  which  is  in  turn  curve - 
fitted  to  a  power  law  vertical  velocity  profile.  DEGADIS  also 
uses  similarity  forms  for  the  vertical  profile  of  gas 
concentration  in  the  cloud,  and  the  vertical  profile  is 
dependent  on  the  power  law  exponent  a  used  in  the 
representation  of  the  velocity  profile.  The  vertical  velocity 
profile,  which  is  directly  related  to  the  air  entrainment 
velocity  into  the  cloud,  is  dependent  on  the  factors  which 
determine  the  structure  of  the  atmospheric  boundary  surface 
layer,  wind  speed,  surface  roughness,  and  atmospheric 
stability.  Consequently,  the  representations  of  the  vertical 
velocity  and  concentration  profiles  in  DEGADIS  are  subject  to 
similar  limitations  as  in  other  descriptions  of  the  surface 
layer.  Table  1.1  indicates  typical  recommended  surface 
roughness  values.  Table  1.2  indicates  logarithmic  wind 


velocity  profile  corrections  for  different  atmospheric 
stabilities,  along  with  typical  values  of  the  wind  profile 
power  law  exponent  a  determined  in  DEGADIS . 


TABLE  1.1 

TYPICAL  VALUES  OF  SURFACE  ROUGHNESS 


Terrain 

ZR,M 

Mud  flats ,  ice 

IQ'5 

Calm,  open  sea 

h-* 

O 

• 

Off- sea  wind  in  coastal  areas 

10-3 

Cut  grass  (-  3  cm) 

0.007 

Long  grass  (-  60  cm) ,  crops 

0.04 

Demonstration  of  the  model  has  been  primarily  directed  to 
the  prediction  of  hazard  extent  defined  by  gas  concentrations 
in  the  hydrocarbon  flammable  limit  range  (-1  to  20%)  .  Even 
though  the  relation  between  peak  gas  concentration  and  time- 
averaged  gas  concentration  is  uncertain,  there  is  some  basis 
for  using  2.0  as  an  estimate  of  the  peak* to • time -averaged* 
concentration  ratio  for  determining  a  flammable  gas 
concentration  zone.  If  this  assumption  is  made,  the  predicted 
distance  to  LFL/2  would  be  the  maximum  distance  at  which  a 
flammable  gas  concentration  would  be  predicted.  Based  on  the 
simulations  of  field  experiments  presented  in  Volume  I,  the 
ratio  of  observed  distance  to  calculated  distance  for  a  given 
time-averaged  concentration  level  (OBS/PRE)  ranged  from  0.82  to 
1.03  for  the  2.5%  level  nine  out  of  ten  times  (i.e.  90% 
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confidence  interval);  for  the  5%  level,  (OBS/PRE)  ranged  from 
0.73  to  0.96  for  a  90%  confidence  interval.  If  for  a  given 
release  scenario  the  calculated  distance  to  the  2.3%  average 
concentration  level  was  120  a,  the  distance  to  the  2.5%  average 
concentration  for  nine  out  of  ten  realizations  of.  the  same 
release  would  be  expected  to  range  between  98  m  and  124  a, 
which  would  also  represent  the  range  of  the  downwind  extent  of 
the  flammable  gas  concentration  zone  for  LNG  if  the  peak- co¬ 
average  ratio  of  2.0  is  assumed. 


II.  DEGADIS  Model  Inputs 

As  implemented  under  VAX/VMS,  DEGADIS  uses  three  areas  of 
input  information: 

(*)  VAX/VMS  command  procedure  for  execution 

(*)  simulation  definition 

(*)  numerical  parameters 

The  VAX/VMS  command  procedure  used  to  execute  DEGADIS  can  be 
generated  in  DEGADISIN.  As  well,  DEGADISIN  is  the  interactive 
input  module  which  provides  the  simulation  definition.  An 
example  input  session  is  included  in  Section  IV. 2.  The 
numerical  parameters  (convergence  criteria,  initial  increments, 
etc.)  are  supplied  to  DEGADIS  through  a  series  of  input  files. 
Although  these  numerical  parameters  are  easily  changed,  the 
user  should  need  to  change  these  only  rarely  with  the  exception 
of  the  time  sort  parameters  which  are  explained  in  Section 
II. 3. 

II. 1.  VAX/VMS  Command  Procedure 

The  VAX/VMS  command  procedure  generated  by  DEGADISIN 
controls  the  execution  of  images  for  the  simulation.  Image 
execution  follows  one  of  two  paths,  either  for  a  transient 
release  or  for  a  steady  state  release.  DEGADISIN  will 
automatically  generate  the  appropriate  command  procedure;  but 
first,  DEGADISIN  requests  a  simulation  name  be  specified.  The 
simulation  name  must  be  a  valid  VAX/VMS  file  name  without  a 
file  extension  and  is  designated  RUNNAME.  DEGADIS  will  use 
this  file  name  with  standard  extensions  for  input,  interprocess 
communication,  and  output.  Figures  II. 1  and  II. 2  show  example 
VAX/VMS  command  procedures  for  the  run  name  BURR09S  for  steady 
state  and  BURR09  transient  releases,  respectively.  The 
directory  which  contains  the  executable  images  of  DEGADIS  has 
been  assigned  the  system  logical  name  SYS$DEGADIS  (see  Appendix 
A) .  The  COPY/LOG  command  simply  copies  a  file  from  the  first 
argument  to  the  second  argument,  and  the  RUN  command  executes 


Che  specified  iaege.  Of  course,  Chese  seeps  may  also  be 
carried  ouc  by  issuing  Che  commands  ac  a  terminal. 


$COPY/LOG  SYS$DEGADIS: EXAMPLE. ER1  BURRO 9 S . ER1 

$COPY/LOG  SYS$DEGADIS : EXAMPLE . ER2  BURR09S . ER2 
$RUN  SYS$DEGADIS:DEGADIS1 
BURR09S 

$RUN  SYS$DEGADIS : SDEGADIS2 
BURR09S 

$COPY/LOG  BURRO 9 S . SCL+BURR09S . SR3 - 

BURRO 9 S . LIS 


Figure  II . 1 .  Example  DEGADIS  command  procedure  on 
VAX/VMS  for  a  steady  scare  simulacion 
named  BURR09S. 


$COPY/LOG  SYS$DEGADIS : EXAMPLE . ER1  BURR09 . ER1 
$COPY/LOG  SYS$DEGADIS : EXAMPLE . ER2  BURR09 . ER2 

$COPY/LOG  SYS$DEGADIS : EXAMPLE . ER3  BURR09 . ER3 

$RUN  SYS$DEGADIS : DEGADIS I 
BURR09 

$RUN  SYS$DEGADIS : DEGADIS 2 

BURR09 

$RUN  SYS$DEGADIS : DEGADIS 3 

BURR09 

$ COPY /LOG  BURR09 . SCL+BURR09 . SR3 - 

BURR09 . LIS 


Figure  II. 2.  Example  DEGADIS  command  procedure  on 
VAX/VMS  for  a  transient  simulation 
named  BURR09. 


II. 2.  Simulation  Definition 


DEGADISIN  is  an  interactive  method  of  simulation  definition 
where  the  user  specifies  information  about  the  ambient  wind 
field,  the  properties  of  the  released  gas,  and  some  details  of 
the  release. 

The  ambient  wind  field  is  characterized  by  a  known  velocity 
Uq  at  a  given  height  zQ,  a  surface  roughness  zR)  and  the 
Pasquill  stability  class.  The  Pasquill  stability  class  is  used 
to  estimate  values  of  the  lateral  similarity  parameter 
coefficients  S  and  0  (Pasquill,  1974),  values  of  the  along-wind 
similarity  coefficients  (Beals,  1971),  and  the  Monin-Obukhov 
length  A  used  by  Businger  et  al.  (1971)  in  their  logarithmic 
velocity  profile  function  *  (Section  I).  The  Monin-Obukhov 
length  is  then  used  to  calculate  the  friction  velocity  u+. 

Once  these  parameters  have  been  estimated  using  the  Pasquill 
stability  class,  the  user  has  the  option  of  interactively 
changing  any  of  these  to  better  describe  the  simulation.  In 
addition  to  these  specifications,  the  ambient  temperature, 
pressure,  and  humidity  must  be  specified. 

.  The  properties  of  air  and  the  released  gas  are  used  to 
evaluate  the  mixture  density  as  a  function  of  temperature  and 
composition.  The  desired  released  gas  properties  include  the 
molecular  weight  MW^,  the  storage  temperature  (normal  boiling 
point  for  cryogenic  gases)  Tq ,  the  vapor  phase  density  at  the 
storage  temperature  and  ambient  pressure  p q,  and  two  constants 
q^  and  p^  which  describe  the  heat  capacity  according  to  the 
equation 

C  (T)  -  MW 
Pc  C 

where  C  (T)  is  the  mean  heat  capacity  (J/kg  K)  at  temperature 
pc 

T.  Note  that  a  constant  heat  capacity  with  respect  to 
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temperature  can  b«  obcainad  by  setting  p,  —  1.0  and  choosing 
cha  appropriate  valua  for  .  Raprasancaclve  gas  propartles 
for  liquafiad  natural  gas  (LNG)  as  methane  and  llquafied 
pacrolaua  gas  (LPG)  as  propana  ara  lneludad  in  DEGADISIN.  Also 
includad  ara  cha  lovar  and  uppar  flammability  limits  (LFL  and 
UFL,  respactivaly)  for  LNG  and  LPG. 

Tha  usar  may  also  choosa  to  calculate  cha  mixture  dans icy 
as  a  function  of  composition  using  soma  ochar  machod.  This 
mixture  density  is  entered  in  cha  program  as  if  cha  release 
ware  isothermal;  for  each  composition,  the  program  requests  cha 
contaminant  mole  fraction,  the  contaminant  concentration,  and 
the  mixture  density.  For  ease  of  input,  these  values  may  be 
entered  from  a  file  made  available  to  DEGADISIN. 

In  specifying  Che  details  of  the  release,  the  user  must 
choose  to  simulate  the  release  as  transient  or  steady  state. 

For  both  release  types,  the  area  source  is  assumed  circular. 

The  source  radius  and  emission  rata  must  be  specified  for  a 
steady  state  release  only  once,  while  these  must  be  specified 
as  a  function  of  time  for  transient  releases  (either 
interactively  or  by  file).  For  transient  releases,  the  usar 
must  specify  the  initial  amount  of  gas  present  over  tha  source 
in  order  to  simulate  an  instantaneous  release  (e.g.  cha  Thorney 
Island  Trials). 

Figure  II. 3  summarizes  the  simulation  information  gathered 
by  DEGADISIN  contained  in  Che  RUNNAME  file  with  extension  IN?. 
The  structure  of  RUNNAME. IN?  is  illustrated  in  Figure  III. 2. 

At  this  point,  RUNNAME. INP  may  be  edited  co  correct  any 
misinformation  entered  during  Che  input  session.  Note  chat 
care  must  be  exercised  when  editing  RUNNAME. INF  due  to  the  fact 
chat  information  contained  in  Che  file  can  be  different 
depending  on  the  answered  questions  (e.g.  steady  scats  versus 
transient  simulation) . 


III.  Model  Imp lemenca cion  and  Outputs 

The  model  described  In  Section  I  has  been  implemented  in 
VAX/VMS  Fortran  (a  superset  of  Fortran  77)  in  the  code  DEGADIS. 
DEGADIS  is  comprised  of  five  separate  programs  as  follows: 

(*)  DEGADIS IN  is  the  interactive  input  module  which 
defines  the  simulation. 

(*)  DEGADIS1  determines  a  and  describes  the  gas  source 
for  transient  and  steady  state  releases. 

(*)  DEGADIS2  describes  the  pseudo- steady  state  downwind 
dispersion  of  the  released  gas. 

(*)  DEGADIS3  sorts  the  results  of  DEGADXS2  for  a 
transient  release. 

(*)  SDEGADIS2  describes  the  steady  state  downwind 
dispersion  of  the  released  gas. 

As  indicated  in  Figures  II. 1  and  II. 2,  a  steady  state  release 
is  simulated  by  executing  DEGADISIN,  DEGADIS1,  and  SDEGADIS2, 
while  a  transient  release  Is  simulated  by  executing  DEGADISIN, 
DEGADIS1,  DEGADIS 2 ,  and  DEGADIS3. 

III.l  Input  Module --DEGADISIN 

DEGADISIN  (see  Section  II)  is  the  interactive  input  module 
which  defines  the  simulation;  DEGADISIN  is  composed  of  two 
subroutines  (Figure  III.l): 

(*)  DEGADISIN  contains  the  program  overhead  and  generates 
the  command  file  RUNNAME.COM  which  can  be 
used  to  control  simulation  execution  (C-29). 


(*)  IOT 


contains  the  interactive  question  and  answer 
sequence  which  defines  the  simulation;  IOT 
also  creates  the  file  RUNNAME.INP  (C-55). 


An  example  of  a  DEGADISIN  query  sequence  is  included  in  Section 
IV. 2.  As  this  information  is  gathered,  it  is  written  to  the 
file  RUNNAME.INP  (see  Figure  III. 2).  Once  DEGADISIN  is 
completed,  RUNNAME.INP  may  be  edited  to  correct  minor  input 
mistakes.  If  major  revisions  are  necessary,  the  recommended 
practice  is  to  execute  DEGADISIN  again. 

Once  Che  information  required  by  DEGADISIN  has  been  entered 
properly,  DEGADIS  may  be  executed  using  the  command  procedure 
generated  by  DEGADISIN  under  the  file  name  RUNNAME.COM.  If 
DEGADIS  is  not  to  be  run  using  this  command  file,  the  user  must 
enter  the  simulation  name  (RUNNAME)  after  each  of  the  programs 
are  begun.  As  well,  the  user  must  provide  copies  of  the 
numerical  parameter  files. 


Figure  III.l.  DEGADISIN  flow  chart. 
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TITLE(4) 

UO,  ZO,  ZR 
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SIGX  COEFF,  SIGX_POW,  SIGX_MIN_DIST 
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'  NP  “ 
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(for  DEN( (J ,2) , J-l ,5) 

external  dens Icy 

calculations) 

NP  of  chase 

DEN(J,NP),J-1,5) 

CCLOW 

GMASSO 

NT 

'  ET(l.l),  ET(2 , 1) ,  R1T(2 , 1) 

ET(1,2) ,  ET(2,2),  R1T(2,2) 

NT  of  chase 
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CHECK1,  CHECK2 ,  AGAIN,  CHECK3,  CHECK4 , 
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only 

Figure  III. 2.  Scruccure  for  free- formatted  RUNNAME.INP 
file. 


8 


$ 

$ 

$ 


$ 


$ 

sfesRSNSSSWNMBBW 


III. 2  Source  Module- -DEGADIS1 


DEGADIS1  estimates  values  for  Che  frlcclon  velocity  and 
ambient  wind  profile  power  a  and  characterizes  Che  primary  gas 
source  for  Che  remainder  of  the  model;  DEGADIS1  is  composed  of 
Che  following  subroutines  (Figure  III. 3): 
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(*)  AFGEN  is  s  utility  which  linearly  interpolates 

between  a  pair  of  points  based  on  a  list  of 
supplied  values  (C-2) . 

(*)  ALPH  estimates  the  ambient  wind  profile  power  a 

by  minimising  the  integral  of  the  difference 
between  an  ambient  logarithmic  velocity 
profile  and  the  assumed  power  law  velocity 
profile  (C-3) . 

(*)  CRFG  creates  a  table  of  calculated  values  which 

will  describe  the  secondary  gas  source  for 
the  downwind  dispersion  calculations  (C-6) . 

(*)  DEGADIS1  contains  the  program  overhead  and 

sequentially  calls  the  routines  required  to 
estimate  the  ambient  wind  profile  power  a 
and  to  characterize  the  primary  gas  source 
(C-U). 

(*)  ESTRT1  recovers  the  numerical  parameters  contained 
in  the  file  RUNNAME.ER1 
(C-35) . 

(*)  GAMMA  is  a  utility  function  that  calculates  the 

gamma  function  of  the  argument  (i.e.  T(x>) 
(C-44). 

(*)  HEAD  writes  a  formatted  output  heading  to  the 

file  RGNNAME.SCL  (C-48) . 

(*)  10  recovers  the  simulation  definition  contained 

in  RUNNAME . IMP  (C-53) . 


24 


(*)  NOBL  estimates  gas  source  behavior  vhen  no  gas 

blanket  is  present  (C-67) . 

(*)  PSIF  calculates  the  p  function  in  the  logarithmic 

velocity  profile  (C-71). 

(*)  RIPHIF  is  a  series  of  utilities  vhich  calculates 

the  Richardson  number  and  the  value  of  ^(Ri) 
(C-81) . 

(*)  RKGST  is  a  utility  routine  vhich  performs 

numerical  Integration  of  a  specified  system 
of  equations  using  a  modified  fourth  order 
Runge-Kutta  method  (C-84) . 

(*)  RTMI  is  a  utility  routine  which  solves  the  trial 

and  error  sec  up  by  ALPH  (C-92) . 

(*)  SRC1  contains  the  ordinary  differential  equations 

vhich  describe  the  gas  blanket  formed  as  a 
result  of  the  primary  gas  source  (C-lll). 

(*)  SURFACE  is  a  utility  routine  vhich  estimates  heat 
and  water  transfer  rates  across  the  bottom 
surface  of  the  gas  layer  (C-147) . 

<*)  SZF  estimates  the  value  of  if  the  primary 

source  can  just  form  a  gas  blanket  over  the 
source  (C-149). 

<*)  TPROP  is  a  series  of  utility  routines  vhich 

estimate  the  thermodynamic  properties  of  a 
given  gas  mixture  (C-152). 


25 


i  v 
ii 

*>,V] 


m 


$;?i 

■  I*.* 

i!>'( 


(*)  TRANS 1  writes  the  inf ormetion  to  continue  the  next 

simulation  step  to  the  file  RUNNAME . TR2 
(C-166) . 

(*)  TRAP  is  a  utility  included  for  program 

diagnostics  (C-174). 

As  input,  DEGADIS1  requires  tvo  files: 


(*)  RUNNAME . ER1  contains  various  numerical  parameters. 

For  most  simulations,  a  copy  of  the 
SYS$DEGADIS: EXAMPLE. ER1  file  will  be 
adequate.  See  Figure  II. 1  or  II. 2.  A  copy 
of  SYS$DEGADIS: EXAMPLE. ER1  is  included  in 
Figure  III. 4. 

As  output.  DEGADIS1  generates  the  following  files: 

(*)  RUNNAME. SCO  contains  the  calculated  values  which 

describe  the  secondary  gas  source.  It  is 
generated  by  SRC1  and  NOBL  and  is  then  read 
by  CRFG;  it  is  a  temporary  file. 

(*)  RUNNAME. SCL  is  the  listed  output  which  describes 

the  input  information  for  the  simulation  and 
the  calculated  secondary  gas  source.  It  is 
written  by  HEAD  and  CRFG. 

(*)  RUNNAME. TR2  contains  the  information  to  continue 
the  next  simulation  step. 


This  is  an  example  of  hou  to  set  up  and  use  the  run  parameter 
input  files.  Comment  lines  start  with  an  exclamation  aark(!) 
in  the  first  column.  The  only  restrictions  for  data  input  are 
as  follows! 

1)  The  data  must  be  entered  in  the  same  order 

all  of  the  time. 

2)  Only  the  nuaber  aust  be  between  columns  10  and  20. 

3)  Always  include  the  deciaal  point  in  the  nuaber 


Coluan  layout! 

23456789012345678901234567890 


1 - 
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I  I 

-3 

STPIN 

0.01 

MAIN  - 

RKGST  -  INITIAL  STEP  SIZE 

ERBND 

0.0025 

MAIN  - 

RKGST  -  ERROR  BOUND 

STPMX 

5.12 

MAIN  - 

RKGST  -  MAXIMUM  STEP  SIZE 

WTRG 

1. 

MAIN  - 

RKGST  -  WEIGHT  FOR  RG 

WTTM 

1. 

MAIN  - 

RKGST  -  WEIGHT  FOR  Total  Mass 

WTYA 

1. 

MAIN  - 

RKGST  -  WEIGHT  FOR  ys 

WTYC 

1. 

MAIN  - 

RKGST  -  WEIGHT  FOR  ac 

WTEB 

1. 

MAIN  - 

RKGST  -  WEIGHT  FOR  Ener3«  Balance 

UTaB 

1. 

MAIN  - 

RKGST  -  WEIGHT  FOR  Moaentua  Balance 

WTuh 

1. 

MAIN  - 

RKGST  -  WEIGHT  FOR  Ueff*Heff 

XLI 

0.05 

ALPH  - 

LOWER  LIMIT  OF  SEARCH  FOR  ALPHA 

XRI 

0.40 

ALPH  - 

UPPER  LIMIT  OF  SEARCH  FOR  ALPHA 

EPS 

0.001 

ALPH  - 

ERROR  BOUND  USED  BY  'RTMI' 

ZLOW 

| 

0.01 

ALPHI  -  maximum  BOTTOM  HEIGHT  FOR  FIT  OF  ALPHA 

STPINZ 

| 

-0.02 

ALPHI  -  INITIAL  RKGST  STEP  <0. 

ERBNDZ 

| 

0.005 

ALPHI 

-  ERROR  BOUND  FOR  RKGST 

STPMXZ 

| 

-0.04 

ALPHI 

MAXIMUM  STEP  FOR  RKGST  <0. 

!  Note 

f 

that  coaaent 

lines  can  be  mixed  with  the  numbers. 

SRCOER 

0.007 

SRC  10 

■  OUTPUT  Error  criteria 

SRCSS 

5.2 

SRC10  -  ain  tiae  for  Steady*  STPMX 

SRCcut 

.0001 

SRC10 

ain  heiaht  for  blanket 

htcut 

.10 

SRC1  - 

ain  height  for  blanket  heat  transfer 

ERNOBL 

1.0005 

NOBL  - 

CONVERGENCE  CRITERIA  ratio 

NQBLPT 

100. 

NQBL  - 

NUMBER  OF  POINTS 

USED  ON  THE  LAST  PORTION  OF  THE  SOURCE 


Figure  III. 4.  SYSSDEGADIS : EXAMPLE .ER1  listing 


erf  Mr  0.008 

i 

epsilon  0.59 


•rror  criteria  in  building  GEN3  vectors 
epsilon  USED  IN  AIR  ENTRAINMENT  SPECIFICATION 


/SPRfl-CON/ 


ce  1.15  constant  in  gravity  slumping  eouation 

delrhoain  0.025  stop  cloud  spread  if  delrho<delrhoain 


/SZFC/ 


SZStPO 

0.01 

SZF  -  Initial  step  size 

szerr 

0.001 

S2F  -  Error  criteria 

SZStPBX 

5.0 

SZF  -  Maximum  step  size  C=3  a 

szszO 

0.01 

SZF  -  Initial  Value  of  della«*Ueff*Heff 

!  /ALPHcoa/ 

j 

ialpfl  1.  ALPHI  -  calculation  flag}  0)  alph3=*alpea*  l)l/(l+z)»  2)1 

alpco  0.2  ALPHI  -  Value  for  alpha  if  IALPFL  =  0 


!  /PHIcoe/ 

i 

iphifl  3.  PHIF  -  calc  flag 

della*  2.15  Raito  of  Hl/Heff 


/VUcoa/ 


vua 

1.3 

vub 

1.2 

vuc 

20.0 

vud 

.64 

vudelta 

| 

0.20 

!  End-of 

-File 

Constant  Av  in  source  aodel 
Constant  Bv  in  source  model 
Constant  Ev  in  source  aodel 
Constant  Dv  in  source  aodel 
Constant  DELTAv  in  source  aodel 


Figure  III, 4.  (continued) 
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III. 3  Pseudo-Steady  State  Module- -DEGADIS2 

DEGADIS2  performs  the  downwind  dispersion  portion  of  the 
calculation  for  each  of  several  observers  released  successively 
over  the  transient  source  described  by  DEGADIS1.  DEGADIS2  is 
composed  of  the  following  subroutines  (Figure  III. 5): 

(*)  AFGEN  is  a  utility  which  linearly  interpolates 

between  a  pair  of  points  based  on  a  list  of 
supplied  values  (C-2). 

(*)  DEGADIS2  contains  the  program  overhead  and 

sequentially  calls  the  routines  to  recover 
the  information  generated  in  DEGADIS1, 
recover  the  numerical  parameter  file 
R0NNAME.ER2,  and  perform  the  simulation 
(C-19) . 

(*)  ESTRT2  recovers  the  numerical  parameters  contained 
in  the  file  RUNNAME . ER2 ,  particularly  the 
number  of  observers  NOBS  (C-39). 

(*)  OB  contains  the  ordinary  differential  equations 

which  average  the  gas  source  for  each 
observer  (C-69). 

(*)  PSS  contains  the  ordinary  differential  equations 

vhich  describe  the  portion  of  the  downwind 
dispersion  calculation  when  b  >  0  (C-72). 

(*)  PSSOUT  governs  the  output  of  calculated  points  to 
the  file  RUNNAME . PSD  when  PSS  is  active 
(C-75) . 


<*)  RIPHIF 


is  s  saris s  of  utilities  which  calculates 
the  Richardson  number  and  the  value  of  <£(Ri) 
(C-81)  . 


(*)  RKGST  is  a  utility  routine  which  performs 

numerical  integration  of  a  specified  system 
of  equations  using  a  modified  fourth  order 
Runge-Kutta  method  (C-34). 

(*)  SSG  contains  the  ordinary  differential  equations 

which  describe  the  portion  of  the  downwind 
dispersion  calculation  when 
b  -  0  (C-122) . 

(*)  SSGOUT  governs  the  output  of  calculated  points  to 
the  file  RUNNAME . PSD  when  SSG  is  active 
(C-124) • 


(*)  SSSUP  is  a  supervisor  routine  which  controls  the 

averaging  of  the  source  for  each  observer, 
the  portion  of  the  downwind  dispersion 
calculation  when  b  >  0,  and  the  portion  of 
the  downwind  dispersion  calculation  when 
b  -  0  (C-132). 


(*)  STRT2  recovers  the  information  generated  in 

DEGADIS1  contained  in  the  file 
RUNNAME.TR2  (C-140) . 


(*)  SURFACE  is  a  utility  routine  which  estimates  heat 
and  water  transfer  rates  across  the  bottom 
surface  of  the  gas  layer  (C-147). 
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(*)  TPROP  is  *  series  of  utility  routines  which 

estimate  the  thermodynamic  properties  of  a 
given  gas  mixture  (C-152). 

(*)  TRANS 2  writes  the  information  necessary  for 
DEGADIS3  to  the  file  (RUNNAME . TR3 ) 

(C-169) . 

(*)  TRAP  is  a  utility  included  for  program 

diagnostics  (C-174). 


<*)  TS 


calculates  the  time  vhen  a  given  observer 
will  be  at  a  given  downwind  distance 
(C-177) . 


(*)  TUPF 


(*)  UIT 


contains  the  two  routines  which  determine 
the  intersection  of  the  upwind/downwind  edge 
of  the  secondary  gas  source  with  a  given 
observer  (C-173). 

is  a  series  of  routines  to  calculate 
observer  position  and  velocity  as  a  function 
of  time  (C-182) . 


As  input,  DEGADIS2  requires  two  files: 

(*)  RUNNAME.ER2  contains  various  numerical  parameters, 

particularly  the  number  of  observers  NOBS. 
For  most  simulations,  a  copy  of  the 
SYS$DEGADIS: EXAMPLE. ER2  file  will  be 
adequate.  See  Figure  II. 1  or  II. 2.  A  copy 
of  SYS$DEGADIS: EXAMPLE. ER2  is  included  in 
Figure  III. 6 


(*)  RUNNAME . TR2  contains  cha  basic  simulation  definition 
as  veil  as  calculated  secondary  source  parameters . 


DEGADIS2  generates  the  following  output  files : 

(*)  RUNNAME. PSD  contains  the  calculated  downwind 

dispersion  parameters  for  each  observer. 
DEGADIS3  sorts  this  information  to  determine 
the  downwind  concentration  profiles  as  a 
function  of  time. 

(*)  RUNNAME. TR3  contains  the  simulation  definition  and 
the  number  of  each  record  type  written  to 
RUNNAME . PSD . 


III. 4.  Time  Sort  Module- -DEGADIS3 

DEGADIS3  sorts  the  downwind  dispersion  calculation  for  each 
of  several  observers  for  concentration  Information  at  several 
given  times;  the  along-wind  dispersion  correction  is  then 
applied  as  desired.  DEGADIS3  uses  the  following  subroutines 
(Figure  III. 7): 

(*)  DEGADIS3  contains  the  program  overhead  and 

sequentially  calls  the  routines  to  recover 
the  Information  generated  in  DEGADIS2, 
recover  the  numerical  parameter  file 
RUNNAME. ER3,  sort  and  apply  the  along-wind 
dispersion  correction  to  the  results  of 
DEGADIS2,  and  output  the  results  (C-24). 


aaftaaia^^ 


*  * 


This  is  an  example  for  an  *ER2*  run  parameter  file 
The  same  rules  sppIm  as  for  the  'ERl1  files. 


23436789012343678901234567890 


l 

— 1 - 

-2 - 3 

!  These 

| 

values  are 

in  common  area  /ERROR/ 

* 

SYOER 

0.03 

SSSUP  -  RKGST  -  INITIAL  SY 

ERRO 

0.005 

SSSUP  -  RKGST (DBS) 

-  ERROR  BOUND 

SZOER 

0.01 

SSSUP  -  RKGST (OBS) 

-  INITIAL  SZ 

UTAIQ 

1.0 

SSSUP  -  RKGST (OBS) 

-  WEIGHT  FOR  AI 

UTQOO 

1.0 

SSSUP  -  RKGST (OBS) 

-  WEIGHT  FOR  0 

WTSZQ 

1.0 

SSSUP  -  RKGST (OBS) 

-  WEIGHT  FOR  SZ 

* 

ERRP 

0.003 

SSSUP  -  RKGST (PSS) 

-  ERROR  BOUND 

★ 

SMXP 

10. 

SSSUP  -  RKGST (PSS) 

-  MAXIMUM  STEP 

★ 

WTSZP 

1.0 

SSSUP  -  RKGST(PSS) 

-  WEIGHT  FOR  SZ 

* 

WTSYP 

1.0 

SSSUP  -  RKGST (PSS) 

-  WEIGHT  FOR  SY 

it 

WTBEP 

1.0 

SSSUP  -  RKGST (PSS) 

-  WEIGHT  FOR  BEFF 

★ 

WTDH 

1.0 

SSSUP  -  RKGST (PSS) 

-  WEIGHT  FOR  OH 

it 

ERR6 

0.003 

SSSUP  -  RKGST (SSG) 

-  ERROR  BOUND 

it 

SMXG 

10. 

SSSUP  -  RKGST ( SSG  > 

-  MAXIMUM  STEP  SIZE 

ERTDNF 

0.0005 

TDNF  -  CONVERGENCE 

CRITERIA 

ERTUPF 

0.0005 

TUPF  -  CONVERGENCE 

CRITERIA 

★ 

WTRUH 

1.0 

SSSUP  -  RKGST (SSG) 

-  WEIGHT  FOR  RUH 

1C 

WTDHG 

i 

1.0 

SSSUP  -  RKGST (SSG) 

-  WEIGHT  FOR  DH 

!  These 

i 

values  are 

in  common  area  /STP/ 

STPO 

0.05 

SSSUP  -  RKGST (OBS) 

-  INITIAL  STEP 

it 

STPP 

0.05 

SSSUP  -  RKGST (PSS) 

-  INITIAL  STEP 

it 

ODLP 

0.06 

SSSUP  -  RKGST (PSS) 

-  RELATIVE  OUTPUT  DELTA 

n 

ODLLP 

80. 

SSSUP-RKGST  <  PSS ) -MAX I  MUM  DISTANCE  BETWEEN  OUTPUTS  Cm) 

* 

STP6 

0.03 

SSSUP  -  RKGST (SSG) 

-  INITIAL  STEP 

* 

ODLG 

0.045 

SSSUP  -  RKGST (SSG) 

-  RELATIVE  OUTPUT  DELTA 

* 

QDLLG 

i 

30. 

SSSUP-RKGST (SSG) -MAXIMUM  DISTANCE  BETWEEN  OUTPUTS (m) 

The  last  variable  NOBS  is  in  /CNOBS/ 


Note;  it  is  read  in  as  a  real  value  even  though  it  is  integer  tape 
in  the  program. 


NOBS  30. 


End-of-File 


♦used  by  steady  state  simulation 


Figure  III. 6.  SYSSDEGADIS : EXAMPLE . ER2  listing 
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(*)  ESTRT3  recovers  the  numerical  parameters  contained 
in  the  file  RUNNAHE . ER3 ,  particularly  the 
time  sort  parameters  (C-43). 


(*)  GETTIM  sets  the  default  time  sort  parameters  as 
needed  (C-46) . 

(*)  SORTS  recovers  the  information  in  RUNNAME.PSD  and 

arranges  the  information  according  to  the 
time  sort  parameters  in  the  file  RUNNAME.ER3 
(C-104) . 


(*)  SORTS 1  applies  the  along-wind  dispersion  correction 
to  the  time-sorted  information  (C-107) . 

(*)  SRTOUT  generates  the  formatted  output  file 
RUNNAME.SR3  (C-119) . 


(*)  STRT3  recovers  the  information  generated  in 

0EGA0IS2  contained  in  the  file  RtJNNAME .  TR3 
(C-145) . 

(*)  TPROP  is  a  series  of  utility  routines  which 

estimate  the  thermodynamic  properties  of  a 
given  gas  mixture  (C-152). 


(*)  TRAMS 3 


(*)  TRAP 


writes  RUNNAME. TR4  which  contains  the 
necessary  information  to  recover  the  other 
output  files  for  this  simulation 
(C-173) . 

is  a  utility  Included  for  program 
diagnostics  (C-174). 
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<*)  TS  calculates  the  time  vhen  a  given  observer 

will  be  at  a  given  downwind  distance 
(C-177)  . 

As  input,  DEGADIS3  requires  three  files: 

(*)  RUNNAME. ER3  contains  various  numerical  parameters 

including  the  time  sort  parameters  and  the 
flag  which  dictates  whether  the  along-wind 
dispersion  correction  is  applied.  A  copy  of 
SYS$DEGADIS : EXAMPLE . ER3  file  uses  the 
default  time  sort  parameters  and  includes 
the  along-wind  dispersion  correction  which 
should  apply  for  most  simulations.  See 
Figure  II. 2.  A  copy  of 
SYS5DEGADIS: EXAMPLE. ER3  is  included  in 
Figure  III. 8. 

(*)  RUNNAME . PSD  contains  the  calculated  downwind 

dispersion  parameters  for  each  observer. 
DEGADIS3  sorts  this  information  to  determine 
the  downwind  concentration  profiles  as  a 
function  of  time. 

(*)  RUNNAME. TR3  contains  the  number  of  each  record  type 
written  to  RUNNAME. PSD  as  well  as  the 
simulation  definition. 


r 


<■*1 


msn 


!  This  is  an  example  for  an  aER3a  run  parameter  file. 

!  The  saae  rules  appla  as  for  the  aERla  files. 

! 

! 23456789012343678901234367890 

j 

!  These  values  are  in  coaeon  area  /ERROR/ 

j 

ERT1  20.  FIRST  SORT  TIME 

ERDT  5.  SORT  TIME  DELTA 

ERNTIM  20.  NUMBER  OF  TIMES  FOR  THE  SORT 

i 

!  Mote:  ERNTIM  is  entered  as  a  real  variable  evert  though 
!  it  is  an  integer  tape  variable  in  the  program. 

i 

!  The  value  of  CHECK5  determines  whether  the  above  sort  parameters 
!  are  used.  CHECK5  is  initialized  through  the  passed  transfer 

!  files  to  .FALSE.  CHECKS  is  set  to  .TRUE,  if  a  real  value  of  I. 

!  is  passed  in  this  file. 

! 

CHECKS  0.  USE  THE  DEFAULT  TIME  PARAMETERS 

! CHECKS  1.  USE  THE  TIME  PARAMETERS  GIVEN  ABOVE 


sisx^flas  1.  correction  for  x-direetion  dispersion  is  to  be  made 

!sisx_flas  0.  no  correction  for  x-direction  dispersion 


End-of-File 


Figure  III.  8.  SYSSDEGADIS  .-EXAMPLE. ER3  listing. 
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As  output,  DEGADIS3  generates  two  nev  files: 

(*)  RUNNAME . SR3  is  the  formatted  output  list  of  the 
time-sorted  concentration  parameters. 
Concentration  contours  are  generated  for  the 
specified  upper  and  lover  flammability  at 
the  specified  height  entered  in  DEGADISIN. 

An  example  is  included  in  Section  IV. 

(*)  RUNNAME . TR4  contains  the  necessary  information  to 

recover  the  other  output  files  to  facilitate 
further  processing. 


III. 5  Steady-State  Module --SDEGADIS2 

SDEGADIS2  is  a  simplification  of  DEGADIS2  which  uses  many 
of  the  same  subroutines.  SDEGADIS2  performs  the  downwind 
dispersion  portion  of  the  calculation  for  a  steady  state  source 
described  by  DEGADIS1.  SDEGADIS2  is  composed  of  the  following 
subroutines  (Figure  III. 9): 

(*)  AFGEN  is  a  utility  which  linearly  interpolates 

between  a  pair  of  points  based  on  a  list  of 
supplied  values  (C-2). 

(*)  ESTRT2SS  recovers  a  subset  of  the  numerical 

parameters  contained  in  the  file  RUNNAME. ER2 
(C-41) . 

(*)  PSS  is  the  same  subroutine  used  in  DEGADIS2;  it 

contains  Che  ordinary  differential  equations 
which  describe  the  downwind  dispersion 
calculation  when  b  >  0  (C-72). 
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Figure  III.  9.  SDEGADIS2  flow  chart. 


the  file  RUNNAME . SR3  vhen  PSS  is  active 
(C-78)  . 

(*)  RIPHIF  is  a  series  of  utilities  which  calculates 

the  Richardson  number  and  the  value  of  d(&i) 
(C-81). 

(*)  RKGST  is  a  utility  routine  which  performs 

numerical  integration  of  a  specified  system 
of  equations  using  a  modified  fourth  order 
Runge-Kutta  method  (C-84) . 

(*)  SDEGADIS2  contains  the  program  overhead  and 

sequentially  calls  the  routines  to  recover 
the  information  generated  in  DEGADIS1 , 
recover  the  numerical  parameters  file 
RUNNAME .  ER2 ,  and  perform  the  steady  state 
simulation  (C-96). 

(*)  SSG  is  the  same  subroutine  used  in  DEGADIS2;  it 

contains  the  ordinary  differential  equations 
which  describe  the  downwind  dispersion 
calculation  when  b  -  0  (C-122). 

(*)  SSGOUT  governs  the  output  of  calculated  points  to 
the  file  RUNNAME . SR3  vhen  SSG  is  active 
(C-124) . 

(*)  SSOUT  writes  RUNNAME. SR3  and  calculates  the 

concentration  contours  (C-130). 


(*)  STRT2SS  recovers  a  subsec  of  che  informacion 

generated  in  DEGADIS1  concained  in  Che  file 
RUNNAME.TR2  (C-143) . 

(*)  SURFACE  is  a  utility  routine  which  estimates  heat 
and  water  transfer  races  across  che  boctom 
surface  of  che  gas  layer  (C-147). 

(*)  TPROP  is  a  series  of  utility  routines  which 

estimate  che  thermodynamic  properties  of  a 
given  gas  mixture  (C-152). 

(*)  TRAP  is  a  utility  included  for  program 

diagnostics  (C-174). 

As  input,  SDEGADIS2  require  two  files: 

(*)  RUNNAME.ER2  contains  various  numerical  parameters; 

the  steady  state  simulation  requires  only 
part  of  these.  For  most  simulations,  a  copy 
of  the  SYS3DECADIS: EXAMPLE. ER2  file 
vill  be  adequate.  See  Figure  II. 1.  A 
copy  of  SYS3DEGADIS : EXAMPL. ER2  is 
included  in  Figure  III. 6. 

(*)  RUNNAME.TR2  contains  the  basic  simulation  definition 
as  well  as  calculated  secondary  source 
parameters;  the  steady  state  simulation 
requires  only  part  of  these. 

As  output,  SDEGADIS2  generates  the  following  files: 


•H 

$ 


;• 

J8 


‘*d 
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(*)  RUNNAME.SR3  is  the  formatted  output  list  of  the 
downwind  concentration  parameters. 
Concentration  contours  are  generated  for  the 
specified  upper  and  lower  flammability  at 
the  specified  height  entered  in  DEGADISIN. 

(*)  RUNNAME. TR3  contains  the  necessary  information  to 

recover  the  other  output  files  to  facilitate 
further  processing. 
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IV.  EXAMPLE  SIMULATIONS 

In  I960,  the  U.S.  Department  of  Energy  sponsored  at  China 

Lake,  California,  a  series  of  nine  LNG  releases  referred  to  as 

the  BURRO  series  of  experiments  (Koopman  et  al.,  1982).  The 

input  conditions  (Table  IV. 1)  for  the  numerical  examples  in 

this  sections  are  those  of  BURRO  9  which  vas  modeled  both  as  a 

steady  state  and  transient  (time- limited)  release.  As 

suggested  by  the  Shell  Map 1 in  Sands  LNG  releases  (Blackmore  et 

al. ,  1982),  the  liquid  source  diameter  was  determined  using  a 

2 

boiling  rate  of  0.085  kg/m  s  for  LNG  on  water. 


TABLE  IV. 1 

SUMMARY  OF  BURR09  TEST  CONDITIONS 


USED  IN  EXAMPLE 

SIMULATIONS 

Source  Rate: 

130.0  kg/s 

Source  Radius: 

22.06  m 

Wind  Speed: 

6 . 5  m/s  at  8.0  m 

Atmospheric  Stability: 

C  (Pasquill) 

Mon  in  -  Obukhcrv  Length: 

-140.  m 

Surface  Roughness: 

2.05  x  10*4  m 

Air  Temperature: 

35.4°  C 

Atmospheric  Humidity: 

12.5% 

Surface  Temperature: 

310  K 

■r.y.v « 
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IV. 1.  Example  Input  Sessions 

The  input  procedures  for  simulation  of  the  transient 
release  (RUNNAME-BURR09)  and  the  steady  state  release 
( RUNNAME-BURRO 9 S )  are  very  similar.  Therefore,  only  the 
specification  of  the  source  rate  and  extent  have  been  included 
for  the  transient  release.  In  the  point-by-point 
discussion  of  the  input  procedure,  note  the  following: 

(*)  A  line  terminator  (normally  a  carriage  return)  must 
end  every  line  entered  by  the  user. 

(*)  The  file  name  specification  RUNNAME  must  satisfy 
system  restrictions. 

(*)  When  DEGADISIN  requests  the  user  to  choose  an  option, 
all  acceptable  responses  are  a  single  character 
(capital  or  lower  case).  The  default  responses  are 
denoted  by  a  capital  letter  inside  angle  brackets 
(e.g.  <N>) .  When  applicable,  a  menu  of  responses  is 
included  inside  parentheses. 

(*)  For  numerical  responses,  a  comma,  space,  tab,  or  line 
terminator  (carriage  return)  may  separate  the  numbers. 

(*)  When  a  file  is  used  as  input  (i.e.  for  the  density  or 
transient  source  input) ,  DEGADISIN  reads  the  same 
information  from  the  file  which  would  be  entered  at 
the  terminal  in  the  same  order  and  in  the  same  format. 


NOTES  ON  STEADY  STATE  SIMULATION  OF  BURRO 9 


© 

© 

© 

© 

© 

© 

© 

© 
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Begin  Che  input  procedure  by  execution  of  DEGADISIN. 

The  file  name  specification  must  follow  system 
restrictions .  The  DEGADIS  model  uses  this  file  name  along 
with  various  file  extensions  for  input  and  output. 

The  Title  Block  is  used  to  carry  any  desired  comments  such 
as  information  on  the  specification  of  certain  parameters. 

The  wind  field  parameters  include  the  wind  velocity  (m/s) 
at  a  specified  height  (m)  and  the  surface  roughness  (m) . 

The  Pasquill  stability  class  is  used  to  generate  estimates 
of  ocher  atmospheric  parameters  which  follow. 

The  current  settings  of  pertinent  atmospheric  parameters 
are  displayed  in  this  list.  If  any  of  these  are  to  be 
changed,  the  first  letter  of  the  parameter  to  be  changed 
is  entered.  Note  that  the  default- - indicated  by  <N>--is 
No  for  no  changes. 

The  Monin-Obukhov  length  (Length  in  the  list)  is  to  be 
changed,  so  L  is  entered  in  response  to  the  prompt. 

The  list  is  redisplayed  to  verify  the  change  and  to 
request  any  further  changes.  The  (default)  response  of  No 
causes  the  program  to  go  to  the  next  question. 

The  ambient  temperature  and  pressure  are  entered. 

DEGADISIN  calculates  the  ambient  air  density  for  the  given 
input  parameters. 


v^ 
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I  run  desadisin 


DEnse  GAs  Dispersion  Model  input  aodule. 


(3)  Enter  the  simulation  name  !  CDIR2RIWNANE  burro9s 
INPUT  MODULE  -  DEGABIS  MODEL 


Enter  Title  Block  —  up  to  4  lines  of  30  characters 
To  stopi  tyre  '//’ 

Steads  state  simulation  of  BURRO  9 

// 

ENTER  HIND  PARAMETERS  -  U0  (•/$)«  20  (a)>  and  2R<aJ 
UO  —  Hind  velocity  at  reference  heisht  20 
2R  —  Surface  Roushness 
6.3>8.»2.05e-4 

Enter  the  Pasouill  stability  class.’  (A tBtCiDtEif)  <S>  c 
The  values  for  the  atmospheric  parameters  are  set  as  follows: 

uaTA:  0.2000 

beta:  o.woo 

Homo-Obukhov  lensth!  -9.3344  a 

Sisma  X  Coefficient:  0.0200 

Sisma  X  Power:  1.2200 

Sisma  X  Minimum  Distance!  130.0000  a 

Do  sou  wish  to  chanie  any  of  these? 

!No»Delta»Beta»lensth»Coefficient»Power»Hiniaum)  <Ji>  L 

Note:  For  infinity?  ML  =  0.0 

Enter  the  desired  Momn-Obukhov  lensth!  (a)  -140. 

The  values  for  the  ataospheric  parameters  are  set  as  follows: 

delta:  0.2000 

beta:  0.9000 

Honin-Obukhov  lensth!  -140.0000  a 

Sisma  X  Coefficient:  0.0200 

Sisaa  X  Power:  1.2200 

Sisma  X  Minimus  Distance!  130.0000  a 

Do  you  wish  to  chanse  any  of  these? 

(NoiDelta»8etailensthiCcefficient»Power?Hiniaum)  <N> 

Enter  the  aabient  teaperature(C)  and  pressure(atm)!  33.4»0.94 


The  aabient  humidity  can  be  entered  as  Relative  or  Absolute. 
Enter  either  R  or  A  \R  or  a/s! 

Enter  the  relative  humidity  fZ)5  12. 5 

10)  Aabient  Air  density  is  1.0731  ks/a**3 


4* ,  *  ,  W*  »*.  -  \  W  V  W-  «r  .  , 


>  A 


If  Che  release  Is  isothermal,  respond  "Y" .  A  positive 
response  causes  DEGADISIN  to  ask  for  a  list  of 
concentration,  density,  and  mole  fraction  points  for  the 
gas  mixture.  The  default  response  is  negative. 

If  Che  release  is  simulated  as  adiabatic,  the  default 
negative  response  is  chosen.  For  inclusion  of  heat 
transfer  effects ,  the  surface  temperature  and  the  method 
of  calculating  the  heat  transfer  coefficient  must  be 
specified. 

Water  transfer  to  the  source  blanket  (if  present)  can  be 
included  in  the  calculation. 

Enter  the  three-letter  designation  of  the  diffusing  gas. 
The  properties  of  LNG  as  methane  and  LPG  as  propane  are 
included. 

A  list  of  the  properties  for  the  specified  gas  (if 
available)  is  given.  If  any  of  the  parameters  are  to  be 
changed,  the  first  letter  of  the  parameter  to  be  changed 
in  the  list  is  given  to  the  prompt.  Here,  the  level  at 
which  the  flammability  contours  are  calculated  is  changed 
from  0.5  m  to  1.0  m. 

The  gas  property  list  is  displayed  again.  The  default 
response  is  no  change. 

The  lowest  concentration  of  interest  is  the  concentration 
at  which  the  calculations  are  stopped. 
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© 

(15) 
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Is  this  an  I so the raw 1  spill?  <a  or  N> 

Is  heat  transfer  to  be  included  in  the  calculations  <a  or  N>  a 
Enter  the  surface  teaperature  C=]  X  i  310. 

Do  aou  want  to  use  the  built  in  correlation*  the  LLM.  correlation*  or 
enter  a  particular  value? 

(Corr»LUtcorr*Value)  <0 

Is  water  transfer  to  be  included  in  the  source  <a  or  N> 

Enter  the  code  naae  of  the  diffusing  species!  Ins 

The  characteristics  for  the  Sas  are  set  as  follows! 

Molecular  wei^it!  16.04 

Storase  teaperature  CK3!  111.70 

Densita  at  storase  teaperature*  FftttB  Cks/ a031!  1.6845 

Mean  Heat  capacita  constant  5.60000E-08 

Mean  Heat  capacita  rower  5.0000 

Upper  Flaaaabilita  Liait  I sole  fracl  0.15000 

Lower  Flaaaabilita  Liait  Caole  fracl  5.00000E-02 

Heisht  of  Flaaaabilita  Liait  Cal  0.50000 

Do  aou  wish  to  chanse  ana  of  these?  (NoiMole>Teap*Oen*Heat>Power>(lpper*Lower>Z)  <N>  z 
Enter  the  desired  Heisht  for  the  flaaaable  liait  calculations!  1.0 

The  characteristics  for  the  sas  are  set  as  follows! 

Molecular  weisht!  16.04 

Storase  teaperature  CM!  111.70 

Densita  at  storase  teaperature*  PAMB  [ks/at*3]!  1.6845 

Mean  Heat  capacita  constant  5.60000E-08 

Mean  Heat  capacita  rower  5.0000 

Urrer  Flaaaabilita  Liait  Caole  fracl  0.15000 

Lower  Flaaaabilita  Liait  Caole  fracl  5.00000E-02 

Heisht  of  Flaaaabilita  Liait  Cal  1.0000 

Do  aou  wish  to  chanse  ana  of  these?  (No*Hole*Tear*&en*Heat*Power*Urper*Lower*Z)  IN> 
Enter  the  L0MEST  CONCENTRATION  OF  INTEREST  (Es/att3)  !  5.e-3 


'«■  .v 
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A  inicial  mass  of  gas  can  be  specified  over  Che  source. 
This  can  be  used  Co  model  aboveground  release  such  as  Che 
Thomey  Island  Trials  and  should  be  zero  for  sceady  state 
releases . 

If  a  sceady  state  release  is  Co  be  simulaced,  type  "Y*  Co 
che  proopc.  For  a  sceady  simulation,  the  sceady  scare 
mass  evolution  race  (kg/s)  and  primary  source  extent  (m) 
are  required. 

A  note  about  che  numerical  parameter  files  is  included. 
These  files  contain  various  constant  values  used  in  che 
programs  co  which  che  user  has  access  wichout  recompiling 
che  programs.  Access  is  granted  as  a  convenience. 

DEGADISIN  will  generate  a  command  procedure  suitable  for 
running  the  model  under  VMS. 


If  so  desired,  DEGADISIN  will  initiate  che  command 
procedure  under  VMS.  If  noc,  che  program  returns  Co  the 
operating  system. 


50 


Specification  of  source  rate  and  extent. 


Enter  the  initial  aass  of  mre  sas  over  the  source,  (ks) 
(Positive  or  zero)!  0. 


Is  this  a  Steads  state  siaulation?  <s  or  N>  s 

Enter  the  desired  evolution  rate  C-l  ks/sec  :  130. 

Enter  the  desired  source  radius  C=3  ■  I  22.06 

In  addition  to  the  inf creation  Just  obtained*  DE6ADIS 
reauires  a  series  of  nuaerical  parameter  files  which  use 
the  saae  naee  as  CDIR3RIDWAME  aiven  above. 

For  convenience*  example  parameter  files  are  included  for 
each  step.  They  are: 

EXAMPLE. ER1  and 
EXAMPLE. ER2 

Mote  that  each  of  these  files  can  be  edited  durins  the  course  of  the 
siaulation  if  a  parameter  proves  to  be  out  of  specification. 

Do  sou  want  a  command  file  to  be  senerated  to  execute  the  procedure?  <Y  or  n> 
The  coamand  file  sill  be  Senerated  under  the  file  name: 
burro9s.com 

Do  sou  uish  to  initiate  this  procedure?  <y  or  N> 

I 


NOTES  ON  TRANSIENT  SIMULATION  OF  BURRO  9 


Beginning  with  Che  specification  of  Che  source  race  and  extent 
Che  responses  Co  all  of  Che  previous  questions  except  the 
simulation  name  (RUNNAME)  are  Che  same  for  Che  steady  state 
case  and  are  noc  repeated . 

^3)  An  initial  mass  of  gas  can  be  specified  over  the  source. 

This  can  be  used  to  model  aboveground  releases  such  as  the 
Thomey  Island  Trials. 


(24) 

(25) 


26 


(27 


The  default  response  is  for  a  transient  release. 


The  transient  source  description  consists  of  ordered 
triples  of  time,  evolution  rate,  and  source  radius. 


An  input  file  can  be  used  to  enter  the  data  triples  to 
avoid  typing  errors  or  to  use  as  output  from  another  model 
such  as  a  liquid  spreading  model.  The  file  format  is  Che 
same  as  the  terminal  entry  format. 


The  first  item  is  the  number  of  triples  used  in  the 
description  followed  by  the  triples  with  the  last  two 
values  showing  no  gas  present. 


DEGADISIN  will  generate  a  command  procedure  suitable  for 
running  the  model  under  VMS. 


If  so  desired,  DEGADISIN  wil  initiate  the  procedure  under 
VMS.  If  not,  che  program  returns  to  the  operating  system. 
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Specification  of  source  rat*  and  extent. 


(23)  Enter  the  initial  eass  of  pure  sas  over  the  source.  (ks) 
(Positive  or  zero):  0. 


Is  this  a  Steads  state  simulation?  <x  or  N> 

Source  Description 

The  saw  fore  used  bx  the  density  description 
is  used  bx  the  source  description  as  follows 

first  point  —  tiee*0  E.R1  at  initial  (nonzero)  values 


nxt  to  last  point  —  time*TEND  E,R1=0. 
last  point  tiaesTDflH  E>R1=0. 

(2  6)  Rote:  the  final  tie*  is  the  last  tiM  entered  where  E  and  R1  are  non-zero 
Do  sou  have  an  input  file  for  the  Source  Description?  Cx  or  N] 

( 27 )  ENTER  THE  NUMBER  Of  TRIPLES  (tax*  30)  FOR  THE  SOURCE  DESCRIPTION:  4 

Enter  TI*  (sec).  EVOLUTION  RATE  (ks/a**3).  and  POOL  RADIUS  (a) 

0., 130. ,22.06 
30. .130. >22.06 

81. >0.f0. 

82.  >0.  >  0. 


In  addition  to  the  intonation  Just  obtained.  DESAOIS 
reeuxres  a  series  of  nuaerical  parameter  files  which  use 
the  saae  name  as  CDIR3RIWNAME  siven  above. 


For  convenience,  txaaplc  parameter  files  are  included  for 
each  step.  Thex  are: 

EXAMPLE.ER1. 

EXAMPLE. ER2,  and 
EXAMPLE. ER3 

Note  that  each  of  these  files  can  be  editted  durins  the  course  of  the 
simulation  if  a  parameter  proves  to  be  out  of  specification. 


Do  sou  want  a  command  file  to  be  Senerated  to  execute  the  procedure?  •.?  or  n> 
The  coamand  file  will  be  senerated  under  the  file  name! 
burro9.com 


29)  Do  xou  wish  to  initiate  this  procedure?  <x  or  N> 
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The  generated  IN?  files  for  BURR09S  and  BURR09  are  shown 
in  Figures  IV. 1  and  IV. 2.  If  necessary,  the  user  may  edit  the 
IN?  file  before  beginning  the  simulation.  The  generated 
command  procedures  are  shown  in  Figures  II. 1  and  II. 2. 

IV. 2.  Example  Simulation  Output 

After  proper  completion  of  the  model,  BURR09.LIS  and 
BURR09S . LIS  contain  che  output  listing  for  the  transient  and 
steady  state  releases,  respectively.  Figure  IV. 3  shows  the 
predicted  maximum  ground  level  centerline  concentration  for 
BURR09  as  well  as  che  maximum  reported  concentration  as  a 
function  of  downwind  distance. 
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SUad a  stats  simulation  of  3USM1  9 


4.500000  8.000000  2.0500000E-04 

3 

0.2000000  0.9000000  -140.0000 

2.0000000E-02  1.220000  130.0000 

308.5500  0.9400000  5.1530441E-03 

0  310.0000 

1  O.OOOOOOOE+OO 
0  O.OOOOOOOE+OO 
Ins 

16.04000  111.7000  1.684480 

5.6000001E-08  5.000000 

0.1500000  S.0000001E-02  1,000000 

4.9999999E-03 
O.OOOOOOOE+OO 

4 

O.OOOOOOOE+OO  130.0000  22.06000 

6023.000  130.0000  22.06000 

6024.000  O.OOOOOOOE+OO  O.OOOOOOOE+OO 

6025.000  O.OOOOOOOE+OO  O.OOOOOOOE+OO 

F  F  F  F  T  F 

16— +4AY-198S  04543528.92 

130.0000  39,10033  39.10033 


Figure  IV. 1.  BURR09S . INP  listing 


Transient  simulation  of  3URR0  ? 


T-  ^ 

I  3 

a;  i—  x  © 

C  S  -O  3  • 

o  ••—  (O  i—  O  CM 
t—  Q£  LL.  <*>  i— 
4->  f—  I— 

a.  •  <u  <u 

•r-  >,  O  U 

S-  -o  i.  i.  ••  •• 

U  (0  3  3  ' — ■  <U 

VI  II  O  O  VI  i- 

<U  l/lv.  3 

<5  O0  CT  *■> 
iu  s_  i.  - — •  i- 

U  ••(0(0  0) 

s-  u  E  g  u  a 

3  O.—  •(-«  E 

a  >,  s-  s_  (O  «j 
(/i  t—  a.  a.  as  i— 


c 

n): 

308 

1 

): 

u 

ai 

XI 

•  •  w  •  •  ^ 

E 

«■■  ^  . .  Hii  >11  1 

3 

m  .e  ••  w 
' — •  ..  •*->  - — ■  ' —  0) 

Z: 

>>  cn^:  s- 

C 

w  4->  C • —  »>  3 

a 

(/I  •*—  QJ  **  +* 

0)  i—  — i  (U  •*-  (O 

"O 

C  f-  i-T3S_ 

W 

•c  x»  >  3  a< 

gtia  ov  g  a 

-C 

3  4-*  .e  (o  3  £ 

u 

O  </l  -K  W  X  0) 

*T“ 

QE  3  0)  t— 

az 

i— 3  aa 
SJi-O  E  >  m 

<u 

u  •»-  i  a)  ^  u 

v/1 

(O  3  C  >-•*->  (O 

<T3 

4-  C3"-(-  (O  4- 

0) 

bVIEkcl. 

r— 

3  (O  O  <U  3 

i/i  nr<  ie  i/i 

u 

a: 

QE  S» 

t/l  U_ 


s-  -a 

S_  01  4) 


O  £  VI 
>UUJ 


|nu  Mwsmmmmams&i  i 


=  555=1 


=  ===  = 


|BD3=S 


as  ss; 


<o 

s  2 

Q 


|9«*-y»iwawwiaK^^E^ss-:fi5Sj 

|ang!3igns3EggE3^^j=i==g= 


I  If**;! 


57 


REFERENCES 


Beals,  G.  A. ,  "A  Guide  Co  Local  Dispersion  of  Air  Follucancs," 
Air  Veather  Service  Technical  Report  214,  April,  1971. 

Blackmore,  D.  R.  et  al.,  "Dispersion  and  Combustion  Behavior  of 
Gas  Clouds  Resulting  from  Large  Spillages  of  LNG  and  LFG 
onto  the  Sea,"  Transactions.  Institution  of  Marine 
Engineers .  94.  1982. 

Businger,  J.  A.,  J.  C.  Wyngaard,  Y.  Izuml,  and  E.  F.  Bradley, 
Flux- Profile  Relationships  ir  the  Atmospheric  Surface 
Layer."  Journal  of  the  Atmospheric  Sciences.  Z,  March, 

1971. 

Colenbrander ,  G.  ?. ,  "A  Mathematical  Model  for  the  Transient 
Behavior  of  Dense  Vapor  Clouds , "  3rd  International 
Symposium  on  Loss  Prevention  and  Safety  Promotion  in  the 
Process  Industries,  Basel,  Switzerland,  1980. 

Colenbrander,  G.  V.  and  J.  S.  Puttock,  "Dense  Gas  Dispersion 
Behavior:  Experimental  Observations  and  Model 
Developments,"  International  Symposium  on  Loss  Prevention 
and  Safety  Promotion  in  the  Process  Industries,  Harrogate, 
England,  September,  1983. 

Koopman,  R.  P.  et  al.,  "Burro  Series  Data  Reports,  LLNL/NWC 
1980  LNG  Spill  Tests,"  Lawrence  Livermore  National 
Laboratories  Report  UCID-19075,  December,  1982. 

Pasquill ,  F.,  Atmospheric  Diffusion.  2nd  edition,  Halstead 
Press,  New  York,  1974. 

van  Ulden,  A.  P. ,  "A  New  Bulk  Model  for  Dense  Gas  Dispersion: 
Two-Dimensional  Spread  in  Still  Air,"  I.U.T.A.M.  Symposium 
on  Atmospheric  Dispersion  of  Heavy  Gases  and  Small 
Particles,  Delft  University  of  Technology,  The  Netherlands, 
August  29-September  2,  1983. 


APPENDIX  A 


DEGADIS  MODEL  INSTALLATION  ON  VAX/VMS 


DEGADIS  was  developed  under  VAX/VMS  V3 . 5  and  VAX-11  Fortran 
V3.5  although  there  should  be  no  installation  difficulty  for 
VAX/VMS  V3.2  or  later. 

The  directory  which  contains  the  Fortran  source  code  for 
DEGADIS  anise  be  equivalenced  with  the  logical  name 
SYS$DEGADIS : .  If  the  full  directory  specification  is 
DQAO: [HACS .DEGADIS] ,  issue  the  VAX/VMS  command: 

$  ASSIGN  DQAO: [HACS. DEGADIS]  SYS$DEGADIS : 
with  either  the  /PROCESS,  /GROUP,  or  /SYSTEM  qualifier  (/SYSTEM 
is  recommended).  Once  this  assignment  is  made,  the  files  must 
be  compiled  and  linked  to  form  DEGADIS IN,  DEGADIS1,  DEGADIS2, 
DEGADIS3,  and  SDEGADIS2.  The  process  which  compiles  and  links 
DEGADIS  onist  have  READ,  URITE,  and  EXECUTE  access  privileges  to 
SYS$DEGADIS  while  only  READ  and  EXECUTE  access  privileges  are 
needed  to  execute  the  existing  models. 


B-l 


APPENDIX  B 

CONSIDERATIONS  FOR  INSTALLATION  OTHER 
THAN  VAX/VMS 


There  are  Cwo  types  of  problems  which  may  occur  when 
attempting  to  install  DEGADIS  on  a  different  computer  or 
operating  system.  The  first  source  of  difficulty  is  the  use  of 
non-standard  ANSI  Fortran  77  language  elements.  The  second 
source  of  difficulty  is  the  use  of  external  VAX/VMS  routines  in 
DEGADIS . 

The  following  list  is  a  collection  of  the  VAX- 11  Fortran 
extensions  which  have  been  used  in  DEGADIS: 

(*)  In-line  comments--An  exclamation  mark  (!)  is  used  to 
include  comments  at  the  end  of  a  valid  statement. 

(*)  Special  characters- -The  underscore  (_)  is  used  in 
variable  names. 

(*)  DO  loops--DO  loops  are  used  with  the  structure: 

DO  v  -  el,e2[ ,e3] 


END  DO 

where  v  is  a  variable  name  and  el,  e2,  and  e3  are 
numeric  expressions.  The  numeric  expressions  have  the 
standard  Fortran  77  meaning. 

(*)  INCLUDE  statements- -INCLUDE  statements  simply  allow 

other  source  files  to  be  inserted  in  the  routine  being 
compiled  at  this  point  in  the  source.  The  system 


cable  '($SSDEF)'  is  used  Co  check  che  scacus  of 
returning  syscem  roucines. 

(*)  OPEN  keyword  NAME- -The  OPEN  keyword  NAME  specifies  che 
file  name  Co  be  opened. 

(*)  Forma c  descripcors- -The  Q  descripcor  obcains  che 

inceger  number  of  characcers  remaining  in  che  inpuc 
record  during  a  READ  operation.  The  dollar  sign  ($) 
descripcor  suppresses  che  carriage  return  ac  che  end 
of  a  line  on  oucpuc. 

(*)  Continuation  lines- -Continuation  lines  have  been 
expressed  by  using  eicher  a  non-blank  character  in 
column  6  or  by  beginning  che  line  wich  a  cab  and  a 
number  in  che  nexc  column. 

(*)  Concatenation  of  character  strings- -Character  strings 
are  concatenated  using  two  slashes  (//) . 

The  following  VAX/VMS  subroutines  have  been  used  in 
DEGADIS : 

(*)  SECNDS 

TIME  -  SECNDS (TIMEO) 

SECNDS  returns  to  TIME  the  difference  between  the 
number  of  seconds  after  midnight  on  che  system  clock 
and  che  value  of  TIMEO. 

(*)  LIB$DATE_TIME 

ISTAT  -  LIB$DATE_TIME  (STRING) 

LIB$DATE_TIME  returns  a  24-character  ASCII  string  with 
the  system  dace  and  time.  ISTAT  is  an  integer 
variable  which  accepts  the  return  status. 

(*)  LIB$DO_COMMAND 

ISTAT  -  LIB$DO_COMMAND  (STRING) 

LIB$DO_COMMAND  issues  the  command  STRING  (a  character 
string)  to  VAX/VMS.  If  the  command  is  issued,  the 
calling  process  is  terminated,  and  ISTAT  will  contain 
a  failure  code . 


APPENDIX  C 


'  CODE  LISTING 


AFGEN.FOR 

C-2 

RKGST .FOR 

C-84 

ALPH.FOR 

C-3 

RTMI.FOR 

C-92 

CRFG.FOR 

C-6 

SDEGADIS2.F0R 

C-96 

0EGA0IS1 .DEC 

C-ll 

SORTS. FOR 

C-104 

DEGADIS1 .FOR 

C-12 

S0RTS1 .FOR 

C-107 

DEGADIS2.DEC 

C-19 

SRC1.F0R 

C-lll 

DEGADIS2.FGR 

C-20 

SRTOUT .FOR 

C-I19 

DEGADIS3.DEC 

C-24 

SSG.FOR 

C-122 

DEGADIS3.FOR 

C-25 

SSGOUT .FOR 

C-124 

DEGADISIN.DEC 

C-29 

SSGOUTSS.FOR 

C-127 

DEGADISIN.FOR 

C-30 

SSOUT.FOR 

C-130 

ESTRT1.FOR 

C-35 

SSSUP.FOR 

C-132 

ESTRT2.F0R 

C- 39 

STRT2.F0R 

C-140 

ESTRT2SS.F0R 

C-41 

STRT2SS.F0R 

C-143 

ESTRT3.F0R 

C-43 

STRT3.F0R 

C-145 

GAMMA, FOR 

C-44 

SURFACE. FOR 

C-147 

GETTIH.FQR 

C-46 

SZF.FOR 

C-149 

HEAD. FOR 

C-48 

TPROP.FOR 

C-152 

10. FOR 

C-53 

TRANS 1. FOR 

C-166 

IOT.FOR 

C-55 

TRANS2.F0R 

C-169 

NOBL.FOR 

C-67 

TRANS2SS.F0R 

C-171 

OB. FOR 

C-69 

TRANS3.F0R 

C-173 

PSIF.FOR 

C-71 

TRAP. FOR 

C-174 

PSS.FOR 

C-72 

TS.FOR 

C- 177 

PSSOUT .FOR 

C-75 

TUPF.FOR 

C-178 

PSSOUTSS.FOR 

C-78 

UIT.FOR 

C-182 

RIPHIF.FOR 

C-81 

C-2 


C . 

c 

C  THIS  FUNCTION  LINEARLY  INTERPOLATES  FROM  THE  GIVEN 
C  PAIR  OF  DATA  POINTS. 

C 

FUNCTION  AFGEN (TABtXt SPEC) 

Illicit  Real*8  <  A-Hf  0-2  )»  Inteser*4  (  I -N  ) 


C 

include  'sysIdeSadisiDEGADISl .dec' 
coeeon/nend/pounrfn » pound 
c 

character*4  pound 
character* <*)  SPEC 
DIMENSION  TABU) 

C 

IF(X  .GE.  TAB(l) )  GO  TO  93 
URITE(lunloSjllOO)  x.spee 
AFGEN  =  TAB(2) 

RETURN 

C 

95  continue 
ix  =  1 


100  Ix  =  ix  +  2 
C 


IY  a  ix  +  1 

IF(  TAB( IX) .EQ.PQUNDN  .AND.  TAB ( I Y ) . EQ . POUNDN  )  GO  TO  500 
IF(X  .GE.  TAB( IX) )  GO  TO  100 


IXP  a  JX-2 
IYP  a  IXP  +  1 
C 

SL  »  (TAB(IY) 
AFGEN  =  SL*(X 
RETURN 
C 

500  CONTINUE 
IX  a  IX-2 
IY  a  IY-2 
IXP  a  IX-2 
IYP  =  IY-2 
C 

SL  a  <TAB(IY) 
AFGEN  =  SL*(X 


TAB(IYP))/(TAB(IX)  -  TAB(IXP)) 
TAB(IXP))  +  TAB (IYP) 


TAB< IYP) )/(TAB(IX)  -  TAB(IXP)) 
TAB(IXP))  +  TAB(IYP) 


C 

1100  FORMAT (2X i '7AFGEN?  UNDERFLOW?  arsueent:  ' » 1ps13.5»5X»A20) 
RETURN 
END 


»#** 


1  —  s«s*deaadi*J AFGEN. FOR 


C  SUBROUTINES  TO  CALCULATE  THE  VALUE  OF  ALPHA 
C 

SUBROUTINE  ALPH 

Illicit  Real  18  (  A-Hf  O-Z  >»  Inteser*4  (  I-N  > 

C 

include  'sasSdeSadisJDEGADISl.dec' 

C 

COMMON 

t/ERROR/STPIN * ERBND  t STPMX >  UTRG » UTta » WTaa  >  wtac » wteb » wtab » wtuh » XL  I  > 
I  XRI » EPS » ZLQW » STP IN2 » ERBNDZ , STPMX2 » SRCOER  *  s r css  > srccut » 

*  htcut > ERNOBL t NOBLpt  » c rta» r  >  epsi 1 on 

l/PARM/UO *  ZO  f ZR » ML » UST AR  t K » G » RHQE » RHOA » DEL  TA » BETA  >  6AMMAF » CcLOU 
$/ ALP/ ALPHA  t a  lPha 1 
*/al?h coe/  islpflnlpco 
C 

REALS8  ML»K 
C 

EXTERNAL  ALPHI 
C 

PSI  »  PSIF(ZO»ML) 

USTAR  =  UO*K/(dLQG< (ZO+ZR)/ZR)  -  PSI) 
c 

if (uO  >ea»  0.)  then 
alpha  a  o. 
ustar  =  0. 
return 
endif 
c 

if (ialpfl.ee.  0)  then 
alpha  3  alpco 
return 
endif 
C 

cm  RMTI  USED  TO  DETERMINE  THE  ROOT  OF  THE  REQUIRED  INTEGRAL  EQUATION 
C 

IEND  *  40 
IER  *  0 
C 

CALL  RTMI  ( X » F  i  ALPH  I ,  XL  I  >  XR I ,  EPS .  IEND  >  I ER ) 

IF(  IER  .NE.  0  )  CALL  trap<l?»IER) 

ALPHA  »  X 
C 

RETURN 

END 

c 

c 

C . 

1  —  sa*»deeadis:ALPH.FOR 


FUNCTION  TO  EVALUATE  THE  WEIGHTED  EUCLIDEAN  NORM  OF  THE 
ERROR  ASSOCIATED  WITH  THE  POWER  LAW  FIT  OF  THE  WIND  PROFILE. 


bu.* 


SB 


1 

a 


s 


FUNCTION  ALPHI(X) 


Illicit  Rea  1X3  <  A-H»  O-Z  )>  InteserM  (  I-N  ) 


include  '  sus*  dedadi  *  DEGAD I  SI .  dec ' 


COMMON 

</ERROR/STPIN»ERBND t STPMX  t WTRG » WTte  t WTaa  t wtac  > wteb » w  tab * utuh » XLI 
I  XRI » EPS  *  ZLOW  >  STP INZ » ERBNDZ  *  STPMXZ , SRCOER  *  s  rcss  *  srccut » 

%  htcut t ERNOBL » NOBLj» t » c rf de r » ee  si 1 on 

f/PARM/UO * ZO » ZR » ML  j  USTAR , K >  G , RHOE  > RHOA » DELTA » BETA » GAMMAF » CcLOU 
«/ALP/ALPHA»alPhal 


REAL *8  ML»K 


DIMENSION  Y(l) »DERY(1) »PRMT<5) »AUX(8) 
EXTERNAL  ARGfARGOUT 


ALPHA  «  X 


PRMT<1)  »  ZO 
PRMT (2)  »  dnaxl(ZLOW»2r) 
PRMT(3)  a  STPINZ 
PRMT(4)  *  ERBNDZ 
PRMT (5)  *  STPMXZ 


!  to  take  care  of  larae  rr 


Y(l)  =  O.ODO 0 


DERY(l)  a  1 ,ODOO 


NDIM  »  i 
IHLF  a  o 


CALL  RKGST < PRMT » Y  t DERY »NDIM» IHLF » ARG» ARGOUT , AUX ) 


IF<IHLF  .GE.  10)  CALL  trae(lS»IHLF) 
ALPHI  »  yd) 

RETURN 


FUNCTION  TO  EVALUATE  THE  ARGUMENT  OF  THE  INTEGRAL  EXPRESSION 


SUBROUTINE  ARG(Z» Y»D»PRMT ) 


—  svsSdedadislALPH.FOR 
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Illicit  Real *8  <  A-H.  0-Z  )»  Int«er*4  (  I-N  ) 

C 

include  's**»d*sadis;DEGADISl .dec' 

C 

COMMON 

l/PARM/UO » ZO i ZR » ML » USTAR » K»  G » RHOE » RHOA » DEL  T A t BET A » GAMNAF  t CcLOU 
$/ ALP/ALPHA f  alphal 
l/al^hco*/  ial?fl»al^co 
C 

REAL <8  ML»K 
C 

DIMENSION  Y(1)»D(1)»PRMT(1) 

C 

Cm  UEIGHT  FUNCTION  USED 
C 

U  »  l.DOO/U.DOO  +  Z) 
if(iaWl.eo.  2)  u*  l.DOO 
C 

Cm  UIND  VELOCITY  0  Z  —  BEST  FIT 
C 

UBST  *  USTAR/K*(dLOG<(Z+ZR)/ZR>  -  PSIF(Z.ML)) 

C 

Cm  UIND  VELOCITY  0  Z  —  PQyER  LAN  APPROXIMATION 
C 

UALP  *  UO  *  (1/10)  t*  ALPHA 
C 

D(l)  ay*  (UBST  -  UALP)  *  dLOG(Z/ZO)  *  UALP 
RETURN 
END 
c 
C 

SUBROUTINE  ARGOUT 

RETURN 

END 

#*♦# 


3  --  aesIdeaadis.'ALPH.FOR 


ooon  nnnn  o  no  nnnno  n  nnonnnno 


SUBROUTINE  TO  CREATE  RADG.QSTR.srcden.srcuc.srcwa.srcenth  DATA  LISTS 

PARAMETERS  —  TABLE  -  WORKSPACE  VECTOR 

NTAB  -  DIMENSION  OF  TABLE  DIVIDED  BY  iout-src 
RER  -  RELATIVE  ERROR  BOUND  OF  CREATED 

DATA  PAIRS  BY  LINEAR  INTERPOLATION 

VALUES  OF  TIME.  RADG.  heidht,  QSTR.  SZO.  *c»  ya.  rho.  Rif 
wc  » ua  »  en  tha  1m  » tnr 
ARE  READ  INTO 

TABL£<1)  TO  TABLE(13)  RESPECTIVELY. 


SUBROUTINE  CRFG (TABLE. NTAB> re p) 

Implicit  Real >8  (  A-H.  0-Z  >»  Int*Ser*4  (  I-N  ) 


DIMENSION  TABLE(l) 

include  ' systdeaadi s  2 DEGADIS1 . dec ' 
parameter  (zero*  l,e-20) 

COMMON 

$/6EN3/  radd<2. maxi ).astr<2. maxi). srcden(2. maxi ).srcwc(2.maxl) . 

S  srcwa(2»maxl) »srcenth<2»maxl) 

>/coaata/  istab. taab.pamb.humid.isofl.tsurf .ihtfl.htco.iutfl.wtco 
$/PARMS C/  RM. SZN . EMAX » RMAX . TSC1 » ALEPH . TEND 
«/PHLAG/  CHECK 1 » CHECK2 . AGAIN » CHECK3 . CHECK 4 . CHECX5 
t/NEND/  POUNDN. POUND 

characters  pound 

LOGICAL  CHECK1 . CHECK2 .AGAIN . CHECK3 . CHECK4 . CHECKS 
DATA  NI/1/ 

data  iti/1/  !  tiae  -  element  no  1  in  record 

data  ire/2/  !  Rads  -  dement  no  2  in  record 

data  ioe/4/  !  Qstar  -  element  no  4  in  record 

data  idn/3/  ?  rho  -  element  no  8  in  record 

data  iwc/10/  !  we  -  element  no  10  in  record 

data  iwa/11/  !  wa  -  element  no  11  in  record 

data  ien/12/  !  enthalpy  -  element  no  12  in  record 


OUTPUT  CREATED  VECTORS  TO  A  PRINT  FILE 


1  --  sysfdemadis: CRFG. FOR 


c 


READ(?»S)  (TA8LE(J)*J»l*iout_src) 


C 

URITE(8* 1111) 

WRITE (3. 1103) 
ifdsofl.eo.  1)  then 
WRITE<8»1102) 

WRITE<8»1103> 

WR1TE(8»1140)  <TABLE(J)FJ»l»6)»table(8)>table<9) 

•Is* 

WRITE<8t 1100) 

WRITE(3*1104) 

WRITE (8» 1140)  (TABLE! J) » J*l»6)  »table<8)  »tabled3)  >  table(9) 
endif 
isrsce  a  1 
C 

1100  F0RHAT(/»3X»'Tiee'»5X»2xF  'Gas  Radius'»2x»4Xr'Heisht'»4X» 

»4x» 'Qatar' »5x»2x»'SZ<x»L/2.)'f2x»lX» 'Hole  frac  C'»2;:» 

•3x»  'Density'  »4x»i;<»  'Teai»erature'»2x»3x»  'Rich  No. '  »3x) 

1102  F0RHAT(/»5X»'Ti*e'»5Xi2:{»'Gas  Radius' »2x»4X, 'Heiaht' »4X» 

$4x» 'Qatar' r3x»2x) 'S2<x*L/2. ) '  »2x»lX» 'Mole  frac  C'»2x* 

*3x» 'Density' *4xi3x» 'Rich  No. ' » 3x> 

1103  FORHATdH  »3X»  'sec'  »6X»6X»  ,7X»<iXf  '•'  »7X» 

I2X » ' ka/e«2/s ' » 3X  #  4X» ' • ' r  7X  » 1 4x  r  3x  r ' k J/»«t3 ' » 4* » 1 4x  * / ) 

1104  FORHATdH  >5X» 'sec' »4X»6X» '■' ,7X,6X» 'a' f7X, 

«2X»  'ks/e«2/s'  »3X*<SX. '»'  .7X»  14x»3x»  'ks/e«3'  »4x»6x» 'X' r7x»14x»/5 

1105  FORHATdH  »23X»  '«*»'  .21X,  'CALCULATED  SOURCE  PARAHETERS '  1 21X » 

) 

C 

RADGdil)  *  0. 

RA0G(2»1>  >  TABLE<2) 

QSTRd»l)  3  o. 

QSTR(2f1)  »  TABLE(4) 
srcdendrl)  a  0. 
srcden(2»t)  a  table(8) 
srcwc(l»l)  *  0. 
srcwc<2>l)  a  tabledO) 
srewadfl)  *  o. 
srcwa(2»l)  >  tabledl) 
sreenthd»l)  »  o. 
srcenth(2»l)  3  table(12) 

C 

READ<9>*)  <TABLE(J)»J3l»iout-sre) 

L  *  2 
C 

Cm  L  IS  THE  NUHBER  OF  RECORDS  WHICH  HAVE  BEEN  READ 
C 

100  CONTINUE 

00  120  I»2»NTAB 
C 

Cm  HOVE  LAST  RECORD  READ  INTO  THE  LAST  ACTIVE  POSITION  OF  TABLE 
2  —  systdesadislCRFG.FOR 


2^ 
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C 

DO  130  J  *  l»iout_sre 
KK  *  iaut-src  t  (1-1)  +  j 
130  TABLE (KK)  *  TABLE(J) 

KK  *  iout-src  *  I 
C 

cm  READ  THE  NEXT  RECORD.  INCREMENT  L. 

C 

L  »  L  +  1 

READ ( 9  *  * » END=900 )  (TABLE( J) » J*l»iout_sre) 

C 

C 

DO  140  Kkk  »  2»I 
C 

KT  »  iout_src*(Kkk-l)  +  x  ti 

KRG  *  iout>src*(Kkk-l)  f  irg 

KQSTR  »  iout..src*<Kkk-l)  +  ias 

KCA  »  iout«src*(Kkk-l)  +  idn 

Kwc  *  iout_src*<Kkk-l)  +  iuc 

Kmj  a  iout_-;rc#<Kkk-l)  +  iwa 

Ken  a  iout_src*(Kkk-l)  +  ien 

C 

timeslot  a  rads(l>ni) 

ratio  »  (table(kt)  -  timeslot)  /  ( tablet iti)  -  timeslot) 
c 

ANSRG  a  (TABLE(ira)  -  RADG(2»NI))  *  ratio  +  RADG(2>NI) 

ANSO  =  (TABLE (ias)  -  QSTR<2>NI) )  *  ratio  +  QSTR(2»NI) 

ANSCA  »  (TABLE(idn)  -  srcden(2»NI) )  *  ratio  +  sreden(2»NI) 

ANSwC  a  (TABLE(iwc)  -  srcwo<2iNI))  *  ratio  +  srcwc(2>NI) 

ANSwa  a  (TABLE(ma)  -  srcw«<2rND)  *  ratio  +  srcwa(2»NI) 

ANSen  =  (TABLE(ien)  -  srcenth(2>NI) )  *  ratio  +  srcenth(2»NI) 

C 

ERRG  a  ABS(ANSRG  -  TABLE(KRG) ) /TABLE (KRG) 

ERQSTR  a  A8S(ANSQ  -  T ABLE ( KQSTR ))/( TABLE ( KQSTR ) +ze  ro ) 

ERO  a  dMAXl ( ERRG » ERQSTR ) 
e 

ERCA  a  ABS( ANSCA  -  TABLE ( KCA )) /TABLE (KCA) 

ERO  »  dMAX 1( ERO > ERCA) 
c 

ERwC  a  ABS< ANSwC  -  TABLE (KwC) )/< TABLE (KwC>+  zero) 

ERO  a  dMAX 1 ( ERO fERwC) 

ERua  a  ABS(ANSwa  -  TABLE (Kwa) )/( TABLE (Kwa)+  zero) 

ERO  a  dMAXl (EROrERwa) 

ERen  =  ABS( ANSen  -  TABLE(Ken) >/(TABL£(Ken)+  zero) 

ERO  «  dMAXl (ER0» ERen) 

C 

IF(ER0  .GT,  RER)  GO  TO  130 
140  CONTINUE 
120  CONTINUE 
C 

URITEdunlos*  1110) 

3  --  sysideiadisJCRFG.FOR 


c 

Cm  RECORD  NEXT  DATA  PAIR,  SINCE  ERROR  EXCEEDED  *  RECORD  THE  LAST 
CS«t  DATA  PAIR  WHICH  SATISFIED  THE  ERROR  CRITERIA  WHICH  IS  STORED 
Cm  IN  TABLE(KK-(iout_src-l))  TO  TABLE(KK) 

C 

150  NX  ■  MX  +  1 

IF<NI  .GT.  MAXI) CALL  trae(5> 
e 

KT  *  KK  -  iout_src  +  iti 

KRG  »  KX  -  iout.src  +  ird 

KQSTR  *  KK  -  iout.src  +  ias 

KCA  »  KK  -  iout.src  +  idn 

KuC  *  KK  -  iout_src  +  iuc 

Kuo  a  kk  -  iout.src  +  iwa 

Ken  *  KK  -  iout.src  +  ion 

C 

RADG(1»HI)  a  TABLE(KT) 

RADG(2,NI)  a  TABLE (KRG) 

QSTR(ltNl)  *  TABLE <KT) 

QSTR(2»NI)  >  TABLE (KQSTR) 
srcden(l,NI)  *  TABLE (KT) 
srcden(2>NI)  a  TABLE (KCA) 
srcwc(l.NI)  a  TABLE (KT) 
srcwc(2fNI)  a  TABLE(KUC) 
srcwa(l.NI)  «  TABLE(KT) 
srcwa(2>HI)  >  TABLE (KWA) 
srcenthd.NI)  a  TABLE(KT) 
srcenth(2»NI)  a  TABLE (KEN) 

C 

Cm  WRITE  THE  POINTS  JUST  RECORDED  TO  UNIT=8 
C 

ifdsofl.es.  1)  than 

WRITE(8> 1140)  (TA8LE( J) » J»kt,kt+3) > table(kt+7) > t3ble<kt+8) 

else 

WRITE(8» 1140)  (TABLE( J) » J»kt,kt+5) » table(kt+7) » 

1  table(kt+12)'table(ktt8) 

end  if 

iseace  a  iseace  +  1 
it (iseace.ee.  3)  then 
i space  «  0 
uriteOr  1111) 
end  if 
C 

GO  TO  100 
C 

900  CONTINUE  !  EOF  encountered 

C 

NI  a  NI  +1 

IF (NI+1  .GT,  MAXL)  CALL  trae(5) 
c 

RAOG(lfNI)  »  TABLE(iti) 


4  —  sestdeaadisJCRFG.FOR 
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RADG(2»NI) 

QSTR(lfNI)  a 

QSTR(2»NI) 

srcden(l»NI)  9 

srcden(2»NI)  9 

srcwcd»NI) 

srcwc(2»NI) 

srcwa(l>NI)  9 

srcua<2>NI) 

src*nth(l»NI) 

srcenth(2»NI) 


TABLE (irs) 
TABLE(iti) 
TABLE(ios) 
TABLE < iti ) 
TABLE(idn) 
TABLE(iti) 
TABLE(iuc) 
TABLE (iti) 
TABLE (iua) 

*  TABLE(iti) 
=  TABLE(ien) 


ifdsofl.ea.  1)  then 

URITE(8>1140)  (TABLE<J)*J=li6),table<8)»t3ble<9) 

else 

URITE(8f 1140)  (TABLE( J) » J*1 >6) > table(8) » table ( 13) r  tsble(9) 
endif 

i space  *  is? see  4  1 
if (ispace.eo.  3)  then 
l  space  *•  0 
write<8> 1111) 
endif 
c 

MI  *  MI  +1 
DO  910  I  *1*2 
RAOG(I.NI)  *  PQUNDN 
QSTR(I.MI)  99  PQUNDN 
SPcden<I»MI)  *  PQUNDN 
srcwc(I*NI)  *  POUND N 
srcwadtNI)  *  PQUNDN 
srcenth(I'NI)  *  POUNDN 
910  CONTINUE 
C 

RETURN 

C 

1110  FORMATd  TCRFG?  TABLE  exceeded  without  point  selection  '* 
)'*  execution  continuina') 

1111  FORMAT ( 1H  ) 

C1140  FORMATdH  *<iout_src><lPG13.A* IX) ) 

1140  FORMATdH  *9dPGt3.A*lX) ) 

END 


##*♦ 


5  —  sws$deaadis)CRFG.FOR 


n  o  n  n  n 


C-ll 


DIMENSIONS/DECLARATIONS  for  DEGABIS1 


include  'swsSdesadislDEGADISIN.dec' 


c  mxI  is  the  lensth  of  the  /GEN3/  outeut  vectors 


parameter  (  1 uni os*  6» 

1  sartei*  1.77  245  3851 » 

2  mxI*  600 1 

3  mx12*  2taaxl  » 

4  iout_src»  13) 


!  sart(ri) 


1  —  sssf desadi s : DEGADIS1 . DEC 
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v 


PROGRAM  DEGADIS1 


c 

C  Program  description! 


DEGADIS1  estimates  the  ambient  wind  profile  power  alpha  and 
characterizes  the  primary  gas  source* 


Program  usage! 


Consult  Volume  III  of  the  Final  Report  to  U.  S.  Coast  Guard 
contract  DT-CG-23-30-C-20029  entitled  'Development  of  an 
Atmospheric  Dispersion  Model  for  Heavier-than-Air  Gas  Mixtures', 


J.  A.  Havens 
T.  0*  Spicer 


University  of  Arkansas 
227  Engineering  Building 
Department  of  Chemical  Engineering 
Fayetteville*  AR  72701 


April  19S5 


This  project  was  sponsored  by  the  U.  S.  Coast  Guard  and  the  Gas 
Research  Institute  under  contract  DT-CG-23-80-C-20029, 


Disclaimer: 


This  computer  code  material  was  prepared  by  the  University  of 
Arkansas  as  an  account  of  work  sponsored  by  the  U.  S.  Coast  Guard 
and  the  Gas  Research  Institute*  Neither  the  University  of  Arkansas* 
nor  any  person  actins  on  its  behalf! 


Makes  any  warranty  or  representation*  express  or  implied* 
with  respect  to  the  accuracy*  completeness*  or  usefulness 
of  the  information  contained  in  this  computer  code  material* 
or  that  the  use  of  any  apparatus*  method*  numerical  model* 
or  process  disclosed  in  this  computer  code  material  may  not 
infrinse  privately  owned  rights*  or 


Assumes  any  liability  with  respect  to  the  use  of*  or  for 
damages  resulting  from  the  use  of*  any  information* 
apparatus*  method*  or  process  disclosed  in  this  computer 
code  material. 


1  --  sysJdededislDEGADISl .FOR 


u  u  u  u  u  u  u  u 
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DIMENSIONS/DECLARATIONS 


Iaelicit  Re3l*8  (  A-H»  Q-Z  )»  Inteder*4  (  I-M  ) 

include  'sssJdedsdisIDEQADISl .dec' 
c 

c  ntsb  is  the  diaension  of  table  divided  by  iout_spc 
c 

?3P3aeter  (  ntab0=91 0* 

$  ntab®nt3b0/iout_src) 

c 

include  '(Jssdef)' 

C 

C  BLOCK  COMMON 

C 

COMMON 

3/GEN3/  P3ds(2*aaxl) *astP<2>aaxl)*SPcden(2»B3xl) *spcuc(2*aaxl) * 

*  s  pcwa ( 2t aaxl ) *s  reentft ( 2 1 aaxi ) 
t/TITL/  TITLE 

S/GEN1/  ET(2»iden) *RlT(2*iden) 

I/6EN2/  DEN(5*iden) 

J/ITI/  T1 *  TINP  * TSRC » TOBS*  TSRT 

i/ERROR/STP IN * ERBND . STPNX * WTRG * «Tta * HTya * wtyc * wteb * utab * utuh *  XLI  * 
i  XR I * EPS » ZLOH » STP INZ * ERBNDZ * STPNXZ » SRCOER * s  rcss  *  s rccut » 

$  htcut  * ERNOBL » NOBL?t  *  c  pf dep  * eps i 1 on 

l/PARM/  UO » ZO * ZR * ML > USTAR * K  *G* RHOE * RHOA * DELTA * BETA* GAMMAF * CcLOU 
S/SZFC/  32st?0 » szer p >  S2sti»»x >  szszO 

3/coa_dPrap/  23s_au*S3s_tea*>*33s_rhoe*S3s_cpk*a3s_cpp* 

%  das.uf 1  *  das_l PI >  dss-zsp  * das_naae 

l/coaata/  ist3b*t3ab*P3ab*huaid*isofl*tsurf * ihtfl»htco*iutf l*wtco 
f/PARMSC/  RM  *  SZM *  EMAX  *  RMAX  *  TEC 1 » ALEPH  *  TEND 

S/coa-ss/  ess*slen*swid*outcc>outsz*outb*outl»swcl* su3l*senl»srhl 

l/PHLAG/  CHECK 1 > CHECK2* AGAIN* CHECK3 * CHECK4*CHECK5 

t/vucoa/  vua * vub * vuc * vud* vudel ts * vuf lad 

t/com.sidx/  sidx_coeff *sidx>pow*sidx_ain_dist*sidx_fl3d 

3 /coa_ENTHAL/  H.ass rte * H_3 i rrte  *  H_w3t rte 

t/H END/  POUNDN* POUND 

l/ALP /  ALPHA* 3lPh3l 

t-'3lpilC0B/  i3l?fl*3lPCO 

S/phicoa/  iphiflrdellsv 

d/s?*d_con/  ce*  delrhoain 

3, 'COM. SURF/  HTCUTS 


2  --  sasSdedsdisJDEGABISl .FOR 


o  n  o  o  o 
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C 

Liiar3Cter*80  TITL£(4) 

r» 

eh3racter*4  pound 
chapacter*24  TSRCiTINP>TOBS»TSRT 
char3ctert3  3as_name 
C 

real*4  ttl 
REAL *8  ML>K 

LOGICAL  CHECK1 >CHECX2 >  AGAIN » CHECKS » CHECK4» CHECKS 
losical  vuflas 

C 

REAL *8  L»LO 

DIMENSION  PRNT(25) »Y<7) »D£RY(7)»AUX(8>7) 

EXTERNAL  SRC1»SRC10 
character#40  opopupI 
character  0PNRUP<40) 
character^  INP*ERl>SCD>TR2>scl 
c 

dimension  table(ntabO) 
c 

eauivalence(opnrup(l) »opnrupl) 


DATA 

DATA  POUNDN/-1. £-20/ » POUND/'//  '/ 

DATA  UST AR/O * / 1 GANNAF/O > / 

DATA  G/9.81/»K/0.35/ 

DATA  GAMNAF/O./ 

DATA  PRMT/25*0./ 

DATA  Y/7*0./>DERY/7*0./ 

DATA  TIMEO/O . / >  ND IM/O/ 

DATA  EMAX/0 . / » TSC1/0 . / 

DATA  ET/isen*0 . » iaentO . / » R1 T/isen*0 . > isentO . / 
data  DEN/isenFO.  f  isenFO.  >isen«Of  iaenW.  t  iaentO./ 

n- 

C 

DATA  INP/'.inp'/>ERl/'.erl'/ 

DATA  SCD/'.scd'/»TR2/'.tr2'/ 
data  scl/'.scl'/ 

C 

c . 

c 

C  MAIN 
C 

C***  GET  THE  EXECUTION  TINE 
C 

tl  =  secnds(0.) 

istat  =  1 ibldate. TIME ( TSRC ) 


3  —  sasIdeaadisJDEGADISl.FOR 
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if(istat  .ne.  ss*_noraal)  stop' lib$date_tiae  failure' 


Cm  GET  THE  FILE  NAME  FOR  FILE  CONTROL 

C 

c  URITE(lunloa>1130) 

cll30  FORMAT (3X» 'Enter  the  file  naae  beina  used  for  this  run:  '»$) 

read<5»1000>  ncharropnrup  !  unit  3  sets  coaaand  file  too 

1000  foraat<a>40al) 


opnrupl  *  opnrupl<i:nch*r>  //  erldM) 

CALL  ESTRTl(OPNRUPl) 

HTCUTS  =  HTCUT 

* 

opnrupl  *  opnrupl (ltnchar)  //  inp(i:4) 
CALL  1 0 ( tend  » SaassO  r OPNRUP 1 ) 

CALL  ALPH 

3lPhal  »  alpha+l. 

WRITE* lunloa> 1105)  ALPHA 
1103  FORMAT <3Xi 'THE  VALUE  OF  ALPHA  IS  ',F6.4> 


GAMMAF  »  GAMMA(1./ALPHA1) 
TSCl  a  TEND 


cm  set  the  density  and  enthalpy  functions  in  TPROP 
c 

call  setenthal ( h_aas rte > h_ a i r r te ? h.uat  rte ) 
call  setden< 1 .D00»0.D00»h_aasrte) 

C 

c . 

c 

C  SOURCE  INTEGRATION  (CA  =  RHOE) 


opnrupl  *  opnrupld Inchar)  //  scd(i:4) 

OPEN ( UNIT=? , NAMEaQPNRUPl > reel *202 » TYPE* ' SCRATCH ' t 
$  carriasecontrol*'list' » 

$  recordtypea'variable' ) 


saass  *  saassO 


START  THE  GAS  BLANKET? 

L  =  SQRTPI<AFGEN<R1T»TIHE0> 'R1T-MN' ) 
QSTRE  *  AFGEN ( £T r TIMEO t ' ET-MN ' ) /L/L 


4  —  sysIdeaadisJDEGADISl.FOR 
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c 

astar  =  0. 
if(u0  .ne.  0.) 

1  astar  3  rhoe<k*ust3r*alPhal*dell3y/(dellay-l. >/phihat(phoe»L) 
c 
c 

write<lunloa>3010)  tiaeOi 1 » sa > astar >astre 
IF(QSTRE.lt.QSTaR  .and.  aaassO.ea.O. >  then 
tscl  *  0. 

SOTO  105 
end  if 
C 

100  CONTINUE 

check3  -  .false. 

C 

C«*  INITIAL  CONDITIONS 

r 

w 

if(tiae0.ne.  0.)  then 

LO  *  SQRTPI*AFG£N<R1T»TIHE0> 'R1T-NN' ) 

QSTRE  3  AFG£N<ET»TINEO» 'ET-NN' )/L0/L0 

c 

astar  =0. 
if(u0.ne.  0.) 

1  astar  3  rhoe*k*ustap*alPh3l*dell3y/(dellay-l. )/phihat( rhoefLO) 

c 

endif 

C 


cm 

SET  UP  INTEGRATION  PARANETERS 

c 

cm 

VARIABLE 

SUBSCRIPT 

mx 

cm 

RG 

y<n 

Cttt 

aass 

Y<2) 

cm 

aassc 

Y(3) 

cm 

aassa 

Y<4) 

cm 

Enthalpy 

Y(5) 

cm 

noe 

y<4) 

CM* 

TINE 

X 

c 

PRMT<1)  3 

TIME0 

PRNT(2)  3 

4.023E23 

PRNT(3)  3 

STPIN 

PRMT(4)  3 

ERBND 

PRNT<5)  3 

3TPNX 

c 

PRNT(A)  3 

I'MAX  —  OUTPUT 

c 

do  iii  3  6t2 3 
prat(iii)  3  0. 
enddo 
C 

m )  =  AFGEN<R1T>TIHE0» 'R1T-MN') 
l  —  sasideaadisJDEGADISl.FOR 


U  UU  CJ  o  ooooo 


Y(2)  3  daaxl<  aaassi  <pimi)«2*l.l*srceut*rhoe) ) 

vuflaa  3  .falsa. 

htod  *  Saass/rhoe/2./pi/Y<l)**3 

prat<22)  *  htod  *  2.*Y<1)  !  initial  heiaht  of  the  tail 

prat(24)  3  ?rat<22) 

?rat<23)  -  0.  !  initial  heiaht  of  the  head 

?rat(25>  3  prat(23) 

if(htod  .St.  0.1)  vuflaa  3  .true. 

Y<3)  3  Y(2) 

Y(4)  3  0.0 

Y(5)  3  Y(3)  *  h-aasrte 
y<6)  3  0.0 
C 

D£RY(1)  3  HTRG 
DERY (2)  3  WTta 
DERY ( 3 )  3  WTac 
DERY ( 4 )  3  UTaa 
DERY (3)  3  UTeb 
dera<6)  3  wtab 
C 

WDIM  3  6 

i»  PERFORM  INTEGRATION 
URITE<lunloS»1145) 

1145  FORMAT (3Xf 'Beainnina  Intasration  Step  -  Gas  blanket') 

CALL  RKGST ( PRMT . Y . DER Y  >  ND1M » IHLF  >  SRC1 » SRC10 » AUX ) 

IF ( IHLF  .GT.  10)  CALL  traP(l,IHLF) 

IF(CHECK3)  than 

TEND  3  TSC1 
GO  TO  110 

end  if 


RESTART  THE  GAS  BLANKET? 

TIME0  3  TSC1 

L  3  SGRTPI*AFG£N<R1T » TIMEO* 'R1T-MN' ) 

QSTRE  3  AFGEN(ET»TIMEOf'ET-NN')/L/L 

c 

astar  =  0. 
if(u0.ne.  0.) 

1  astar  3  rhoa*klustar*alPhal*dellaa/(dallaa-l . )/Phihat( rhoe»L) 
c 

urite(lunloa>3010)  tiaeO» l>sz> astar >astre 
3010  foraat<//» '  tiaeOJ  'rlpal3.3»t40»'l!  '»leal3.3» 

*/»'  ssO:  '»lP3l3.5»/f '  astar!  ' »lpal3.5»t40? 'astre!  '»1ps13.5) 
IF (QSTRE  .Gt.  QSTaR)  GO  TO  100 


6  —  sastdeaadisSDEGADISl .FOR 


r>  o  o 


SOURCE  INTEGRATION  —  NO  GAS  BLANKET 


105  continue 

WRITER lunloa» 1146) 

1146  FORMAT <5Xt 'Source  calculation  -  No  Gas  blanket') 

C 

CALL  NOBL(tiaeout) 
c 

if(check3)  then  !  restart  blanket  calculation 

tiaeO  *  tiaeout 
Soto  100 

end  if 
C 
C 

110  RMAX  *  1 .01IRHAX  !  GUARANTEE  A  GOOD  VALUE 

aleph  =  0. 
if(uO  ,ne.  0.) 

1  ALEPH  *  UO/GAMMAF*  <  SZM/ZO ) **ALPHA 

2  /<SQRTPI/2.*RM  +RMAX)** (ALPHA/ ALPHA 1) 


C 


reuind  (unit=9) 

opnrupl  »  opnrupld.'nchar)  /.'  scl(114) 
open  <  un  i  t=8 » naae=opn  r  up 1 1  type* ' new ' t 

*  csrriasecontrol*' fortran' »  recordtape*' variable ' ) 


call  head(saassO) 

call  crfa(table*ntab»erf3er) 

call  head(aaassO) 


c 

CLOSE (UNIT-?) 


C 


close(unit=8) 


opnrupl  *  opnruPlCl Inchar)  //  tr2(lJ4) 
CALL  TRANS (0PNRUP1) 

C 

Cm  CALCULATE  EXECUTION  TIME 


ttl  =  tl 

tl  =  Secnds<tTl)/60. 

WRITE* lunloSi 2000)  TSRC 
WRITE<Iunlos»2010>  Tl 
2000  FORMAT ( IX » 'BEGAN  AT  ',A24) 

2010  FORMAT (5X» '  *****  ELAPSED  TIME  *****  '>1p313.5>'  ain  ') 
C 

STOP 

CND 

***♦ 


T  —  sasSdesadisJDEGADISl.FOR 


o  n  o  ooooo 


C-19 


DIMENSIONS/DECLARATIONS  for  DEGADIS2 
include  's»**dedadis:DEGADISl. dee/list' 
HAXNOB  IS  THE  MAXIMUM  NUMBER  OF  OBSERVERS 

para**tar<  aaxnob  a  50 » 

1  RT2»  1.41  421  3562  > 

2  saPio23  1.25  331  4137) 

C 

**♦* 


ALLOWED. 

!  sart(2.0) 

!  sort ( Pi/2.) 


1  —  s«s*d#aadi  s .'  DESADIS2 .  DEC 


PROGRAM  DEGADIS2 


C 

ctxxxxxxxxxxxxxxxxxxxxxxxtxxxxxxxxxxsxxxxxxxxxxxxxxxxtxxxxtxxxxxxxxxxtxxxxxx 

ctxxxxxxxttxxxxxxxxxxxtxxxxxxxxxxxxxxxxxtzxxxxxxxxxxxxxxxxxxxxxxxxxxxxtxxxtx 

c 

C  Proaraa  description! 

C 

C  DEGADIS2  performs  the  downwind  dispersion  portion  of  the  calculation 

C  for  each  of  several  observers  released  successively  over  the  transient 

C  sas  source  described  by  DEGADIS1. 

C 

C 

C  Prosraa  usase! 

C 

C  Consult  Voluae  III  of  the  Final  Report  to  U.  S.  Coast  Guard 
C  contract  DT-CG-23-80--C-20029  entitled  'Development  of  an 

C  Atmospheric  Dispersion  Model  for  Heavier-than-Air  Gas  Mixtures'. 

C 

C  J.  A.  Havens 

C  T.  0.  Spicer 

C 

C  University  of  Arkansas 

C  227  Ensineerina  Buildins 

C  Departaent  of  Cheaical  Ensineerina 

C  Fayetteville.  AR  72701 

C 

C  April  1985 

C 

C 

C  This  project  uas  sponsored  by  the  U.  S.  Coast  Guard  and  the  Gas 

C  Research  Institute  under  contract  DT-CG-23-80-C-20029 . 

C 

C 

C  Disclaimer! 

C 

C  This  coaputer  code  aaterial  uas  prepared  by  the  University  of 
C  Arkansas  as  an  account  of  work  sponsored  by  the  U.  S.  Coast  Guard 

C  and  the  Gas  Research  Institute.  Neither  the  University  of  Arkansas* 

C  nor  any  person  actins  on  its  behalf! 

C 

C  a.  Makes  any  warranty  or  representation*  express  or  implied* 

C  with  respect  to  the  accuracy*  coapleteness*  or  usefulness 

C  of  the  inforaation  contained  in  this  coaputer  code  material* 

C  or  that  the  use  of  any  apparatus*  method*  numerical  model* 

C  or  process  disclosed  in  this  coaputer  code  aaterial  may  not 

C  inf rinse  privately  owned  rishts*  or 

C 

C  b.  Assuaes  any  liability  with  respect  to  the  use  of*  or  for 
C  daaases  resultins  from  the  u-je  of*  any  information* 

C  apparatus*  method*  or  process  disclosed  in  this  computer 

1  —  sys*desadis!DEGADIS2.F0R 


n  o  n  o  o  o  or»or>oor>r»r> 


cod*  aaterial. 


xttxxxxxttxxtttxxxxxxxxxxxxtxxxtxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxttxxttt 

xttxtttxxxtxtttxxtxxttxxxxtxtxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxtxxxxxxxtxxxxt 


DIMENSIONS/DECLARATIONS 


Illicit  Real *8  <  A-H»  0-Z  )»  Int*S*r«4  (  I-N  ) 

include  '  tysldeaadis  i  BEGAD  132 .  dec/ list' 
includ*  '(assdef)' 

COMMON 

4/GEN3/  radd(2>  aaxl) »astr<2>aaxl) >srcd*n(2»aaxl) *srcwc(2>«axl ) » 

a  srcwa(2>aaxl)nrc*nth<2>aaxl) 

a/SSCON/  NREC  ( aaxnob » 2 )  *  TO  ( sax-nob )  >XV<  aaxnob ) 

a/TITL/  TITLE 

a/GENl/  ET (2* iden) >R1T (2> iden) 
a/GEN2/  DEN(3» iaen) 

a/PARN/  UOf ZO»ZR»ML»USTAR»K»G» RHOE»RHOA .BELT A, BET A, GAMMAF » CcLOU 
*/co*_jr>rop/  aas.aw»  aas_ teap ? aas. rhoe*  sas_cpk. # aas.cpp * 

$  aas-uf 1 »aas_lf 1 >aas_rsp»  sas_naae 
a/ITI/  T1 » TINP  f TSRC  t TOBS » TSRT 

S /ERROR/S Y OER » ERRO » SZOER » WTAIO  * WTQOO  »  HTSZO  >  ERRP > SMXP  > 

t  UTSZPf UTSYP f WTBEP fWTDHf ERRG fSMXGfER TDNF » ERTUPF , UTRUH f WTDHG 

a/co*ata/  istabi taab»paab»huaid» isof 1 » tsurf > ihtf 1 »htco> lutf 1 » wtco 

l/PARMSC/  RM » SZM  t EMAX , RMAX *  TSC1 f ALEPH . TEND 

i /STP/  STPO, STPP >  ODLP » ODLLP f STPG  fODLGf ODLLG 

l/PHLAG/  CHECK 1 # CHECK2 » AGA INf CHECK3 . CHECK 4 » CHECKS 

a/co*.siax/  siSx.eoeff Fsidx_rowFSiax_ain_distFSiax_fl3S 

a/NEND/  POUNDNf POUND 

a/ALP/  ALPHAialPhal 

a/phico*/  iPhiYl>d*llay 

a/sprd_con/  cei  delrhoain 

a/C0M_SURF/  HTCUT 

a/STOPIT/  TSTOP 

a/CN08S/  NOBS 

charact*rf80  TITLE(4) 

characters  pound 
charact*r«24  TINP.TSRCf TOBS » TSRT 

axsadcaadi s : BEGAD IS2 . FOR 


C-22 


char3cter*3  3as_nsae 
c 

PM  1*4  ttl 
REAL*8  K1HL1L 

LOGICAL  CHECK1 » CHECKS > AGAIN*  CHECK3 > CHECK 4 1 CHECKS 
C 

character *4  TR2>ER2>PSD>TR3 
character  QPNRUPUO) 
character *40  0PNRUP1 
•am valence  (opnrur<l)»opnrupl> 

C 

C . 

c 

C  DATA 
C 

DATA  TSTOP/O./ 

DATA  POUND/'//  '/,P0UNDN/-l,£-20/ 

C 

DATA  TIM£0/0,/»NDIM/0/ 

DATA  RADG/aaxl 2*0 . / t GSTR/aax 12*0 ♦ / t s r cden/aaxl 2*0 . / 

DATA  NREC/aaxnob*0 » «axnofc>*0/ >  T 0/aa::nob*0 .  /  *  XV/i»axnob*0 . / 

C 

DATA  TR2/'.TR2'/»ER 2/'.ER2'/ 

DATA  PSD/' .PSD'/»TR3/' .TR3 V 
C 

C . * . 

c 

C  MAIN 

C 

T1  3  SECNDS<0.) 

istat  =  liMdat*_TINE(T08S) 

ifdstat  .ne.  ss*_noreal)  stOP'lib*date_tiae  failure' 

C 

CUt  GET  THE  FILE  NAME  FOR  FILE  CONTROL 
C 

c  URITE<3»1130) 

cll30  FORMAK '  Enter  the  file  naee  beind  used  for  this  run?  '»$) 
read(3>1130)  nchar>apnryp 
1130  faraat(a*40al) 

C 

opnrupl  *  OPNRUPKl  Jnchar)  //  er2d54) 

CALL  ESTRT2<0PNRUP1) 

C 

C***  GET  THE  COMMON  VARIABLES  CARRIED  FROM  DEGADIS1 
C 

opnrupl  3  OPNRUPKl  Jnchar)  //  t r2<  1 1 4 > 

CALL  S  TRT2  ( OPNRUP 1 »  H.ms  r te ) 

C 

C 

C . 

C 

3  —  sws tdesad i s 5 DEGAD IS2 . FOR 


o  o  o  n  o  o  o 


PSEUDO  STEADY  STATE  CALCULATIONS 
INTEGRATION  IN  SUBROUTINE  SUPERVISOR 

oanruPl  *  QPNRUPKl  inchar)  //  psd(l!4) 
OPEN<  UNI T=9 » TYPE*' NEW ' *  NANE*OPNRUP 1 » 

*  carrias#control*'list'» 
i  rtcordtsp**' variable') 

CALL  SSSUP(H_aasrte) 


CLOSE<UNIT=?) 

c 

c 

call  satdend.  »0.  »H_aasrte)  !  adiabatic  aixina  w/  pur»  stuff 
c 
C 

opnrupl  *  OPNRUPld  inchar)  //  tr3d!4> 

CALL  TRANS (OPNRUP1 ) 

C 

ttl  *  tl 

Tl  *  SECNDS(tTl) 

T1  *  Tl/60. 

URITEdunloa>4000)  TOBS 

WRITEdunloa»4010)  Tl 
4000  FORMAT <3X, 'BEGAN  AT  ' ,A40) 

4010  FORMAT (3X» 'ttt  ELAPSED  TINE  *«  '>1pG13.3»'  ain') 

C 

STOP 

END 

**#* 


4  —  s«s$daaadis!DEGADIS2.F0R 


C-24 


c 

c 

e 

c 

c 


c 

♦*#* 


declarations  for  DEGADIS3 

include  ' sasSdesad is : BEGAD I S2 . dec/ list' 

paraaeter  <  aaxnt340> 
t  B3xtnob=aaxnttaa:<nob) 


1  —  sxs*deSadis:D£GADIS3.D£C 


PROGRAM  DEGADIS3 


C 

c 

C  P roars*  description: 

C 

C  0E6ADIS3  sorts  the  downwind  dispersion  calculation  made  for  each  of 
C  the  several  observers  in  DEGADIS2.  The  output  concentrations  at 
C  several  diven  times  maw  then  be  corrected  for  alons-wind  dispersion 
C  as  desired. 

C 

C 

C  Prosram  usadeJ 

C 

C  Consult  Volume  III  of  the  Pinal  Report  to  U.  S.  Coast  Guard 
C  contract  DT-CG-23-80-C-20029  entitled  'Development  of  an 

C  Atmospheric  Dispersion  Model  for  Heavier-than-Air  Gas  Mixtures'. 

C 

C  J.  A.  Havens 

C  T.  0.  Snieer 

C 

C  University  of  Arkansas 

C  227  Enaineerind  Buildind 

C  Department  of  Chemical  Engineering 

C  Fayetteville*  AR  72701 

C 

C  April  1985 

C 

C 

C  This  project  was  sponsored  by  the  U.  S.  Coast  Guard  and  the  Gas 

C  Rssearch  Institute  under  contract  DT-CG-23-80--C-20029. 

C 

C 

C  Disclaimer: 

C 

C  This  computer  code  material  was  prepared  by  the  University  of 
C  Arkansas  as  an  account  of  work  sponsored  by  the  U.  S.  Coast  Guard 

C  and  the  Gas  Research  Institute.  Neither  the  University  of  Arkansas* 

C  nor  any  person  actind  on  its  behalf: 

C 

C  a.  Makes  any  warranty  or  representation*  express  or  implied* 

C  with  respect  to  the  accuracy*  completeness*  or  usefulness 

C  of  the  information  contained  in  this  computer  code  material* 

C  or  that  the  use  of  any  apparatus*  method*  numerical  model* 

C  or  process  disclosed  in  this  computer  code  material  may  not 

C  infrinde  privately  owned  rights:  or 

C 

C  b.  Assumes  any  liability  with  respect  to  the  use  of*  or  for 
C  damaaes  resultind  from  the  use  of  *  any  information* 

1  —  sysf dedadis : DEGADIS3 . FOR 


C  apparatus*  aethod*  or  procees^disclosed  in  this  computer 

C  cod*  Bate rial» 

C 

C 

c 

c 

c 

c 

Ieplicit  Real»8  (  A-H*  0-Z  )*  Inte3er*4  (  I-N  ) 

include  ' svstdedadi s l DEGAD IS3 . duc/l is t ' 
include  ' (Issdef)' 

C 

C*«  MINIMUM  DIMENSION  ON  TABLE  IS  6  *  MAXNOB  +  1 
C 

paraaeter  (ntab0*10*aaxnob+l) 

C 

COMMON 

S/SORT/  TCA< aaxnob* aaxnt) *TCASTR( aaxnob* aaxnt) » 
t  Tuc(a3xnob*aaxnt)*Trho(aaxnob*aaxnt) * 

t  TS3aaa< aaxnob *aaxnt)*Ttemp< aaxnob* aaxnt) * 

*  TSY ( aaxnob * aaxnt ) * TSZ( aaxnob *  aaxnt ) » TB(  aaxnob  * aaxnt ) * 

*  TDISTQ<  aaxnob*  aaxnt ) *  TDIST ( aaxnob  * aaxnt ) *KSUB( aaxnt) 
t/SSCON/  NREC  ( aaxnob  *  2 ) *  TO  <  aaxnob ) *  XV  <  aaxnob ) 

*/S0RTIN/  TIM(aaxnt) *NTIN*ISTRT 
4/GEN2/  DEN<3* isen) 

f/PARN/  UO  *  ZO  *  ZR » ML  *  UST AR » K  *  G  * RHOE >RHQA* DELTA* BETA . GAMMAF *  C AL  OU 
t/coa_3Prop/  3as.au » 3as_  tea*  *  sas. rhoe  *  aas-CPk  *  sas.cpp  > 

$  3as_uf 1  * aas.lf 1  *  33S.2SP *  3as_naae 
*/ITI/  T1 *  TINP  *  TSRC  *  TOBS *  TSRT 

t/coaata/  istab*taBb»P3Bb*huaid*isofl*tsurf *ihtfl*htco*iutfl*utco 
t/PARMSC/  RM* SZM  *  EMAX  *RMAX  *  TSC1 *  ALEPH  *  TEND 
$/PHLAG/  CHECK 1  *  CHECK2 *  AGAIN* CHECX3  *  CHECK4 » CHECKS 
*/coa_si3x/  si3x_coef f *  si3x_pow  *  s i 3x_ain_dist  *  si3x_f 1 33 
t/ERRQR/  ERT1*ERDT*ERNTIM 
*/NEND/  POUNDN* POUND 
*/ALP/  ALPHA»alphal 
t/CNOBS/  NOBS 
C 

LOGICAL  CHECK 1  *  CHECK2  >  AG A I N ♦ CHECK3 *  CHECK4 *  CHECKS 
REALS8  ML»K 
DIMENSION  TABLE (ntabO) 
c 

character*24  tsrc*tinp*tobs*tsrt 
C 

character <3  sas.naae 
character*4  TR3*PSD*Er3*SR3*Tr4 


2  —  sxsSdeeadi s J DEGAD IS3 . FOR 


character*40  ornrurl 
character  ornrur<40) 

C 

EQUIVALENCE  <OPNRUP(l)»oi»nruPl) 

C . 

c 

C  DATA 
C 

DATA  POUNDN/- 1 . £-20/ » POUND/ ' //  '/ 

DATA  TCA/eaxtnob*0 . / » TCASTR/eaxtnobtO . / » TSY/aaxtnobtO . / 
data  TSZ/aaxtnob*0 . / » KSUB/eaxnt*0/ 

DATA  TB/eaxtnob<0 . / » TDIST 0/eaxtnob*0 . / 1 TBIST/eaxtnobtO . / 

C 

DATA  TR3/'.TR3'/»PSD/'.PSD'/ 

DATA  Er3/' .Er3'/#SR3/' .SR3'/»Tr4/' .Tr4'/ 

C 

cm  UNITS 

cm  3  —  OUTPUT  TO  A  PRINT  FILE 
Cm  ?  I/O  WtTH  DISK 
C 

T1  a  SECNDS ( 0 . ) 

istat  =  libtdate-tiee<tsrt) 

ifdstat  .ne.  ss$-nornal)  stoe'libtdate.tiae  failure' 

C 

C 

Cm  GET  THE  FILE  NAME  FOR  FILE  CONTROL 
C 

c  WRITE(3f 1130) 

cll30  FORMAT ( '  Enter  the  file  naee  used  fop  this  run:  '»*) 
read(5*1130)  nchar> or nr up 
1130  foraat(a»40al) 

C 

Cm  GET  THE  VERSION  NUMBER 
C 

c  100  HRITE(5» 1140) 

cl 140  FORMAT ('  Enter  the  version  nueber  (between  00  and  99)  for'» 
c  *'  this  sort:  '»*) 
c  CALL  GTLIN(DUMMY) 

c  NCAR  *  LEN< DUMMY) 

c  IF(NCAR  .EQ.  0)  50  TO  110 

C 

c  IF ( I VERIF ( DUMMY* STRING )  .NE.  0)  GO  TO  110 

c  IF(NCAR-2)  130»140>120 

C 

c  110  WRITE<5> 1130) 

cll30  F0RMAT('  7DE5ADIS3?  -  Invalid  character  for  version  nueber') 
c  GO  TO  100 

C 

c  120  WRITE<5» 1160) 

cllAO  F0RMAT('  7DEGADIS3?  -  Too  aans*  characters  in  the  version  nueber') 
c  GO  TO  100 

3  —  sws$desadis:DEGADIS3.F0R 


Tqpqrww  »nm  kv  i^wwwm 
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C 

e  130  DOT ( 1 )  =  *060 

c  D0T(2)  »  DUMMY < 1 ) 

c  GO  TO  150 

C 

c  140  D0T(1)  =  DUMMY ( 1 ) 

c  D0T<2)  =  DUMMY (2) 

C 

c  ISO  CONTINUE 

e  CALL  C0NCAT ( E  r3  >  DOT » E  p3  ) 
c  CALL  C0NCAT(Sr3«D0TfSr3) 

c  CALL  C0NCAT ( Tr  4 » DOT » T  i*4 ) 

C 

cm  N0W>  REPLACE  THE  PILE  NAME  IN  QPNRUP 
C 

c  CALL  SC0PY ( BFILE  >  0PNRUP ) 

C 

C*W  THATS  IT 
C 

opnrupl  a  opnrupld Jnchar)  //  tr3 <  114) 

CALL  STRT3(0PNRUP1) 

C 

opnrupl  a  oprirupl (llnchar)  //  er3(i:4) 

CALL  ESTRT3  <  0PNRUP 1 ) 

C 

opnrupl  *  opnrupKl.’ncftar)  //  PStUll 4) 

0PEN(UNIT=9 , NAME=0PNRUP1 » TYPE* '  OLD ' > 

C 

C . 

c 

c  TIME  SORT  SUPERVISOR  ~  CALCULATE  DOWNWIND  DISPERSION  CORRECTION 
C 

CALL  SORTS (TABLE) 

C 

CLOSE (UNIT=9) 

C 

C . . . 

c 

C  OUTPUT  SORTED  PARAMETERS 
C 


c 

c 

♦#** 


opnrupl  *  opnruPl(lJnchar)  //  SR3(154) 
CALL  SRTOUT(OPNRIJPl) 

opnrupl  *  opnnjpl (lJnchar)  //  t p4 C 1 : 4 ) 
CALL  TRANS (0PNRUP1 ) 

STOP 

END 


4  —  sviidaaadi* :DEGADIS3.P0R 


declaration*  for  DESADISIN 


?ir>Mttr(  ia#n«  30»  !  di»*n*ion  of  /aenl/  and  /a»n2/ 

1  *i»  3.14  15?  2654) 


1  —  swstdeaadislDEGADISIN.DEC 
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MtTTITTTII 


mm 


PROGRAM  DEGAOISIN 


Program  description! 


DEGAOISIN  acts  as  an  interactive  inrut  Module  to  the  programs 
which  aake  up  the  DEGAOIS  model.  The  user  is  iuided  throush  a 
series  of  ouestions  which  supply  the  eodel  with  the  necessary 
input  information. 


Prosraa  usage: 

Consult  Volume  III  of  the  Final  Report  to  U.  S.  Coast  Guard 
contract  DT-CG-23-80-C-20029  entitled  'Development  of  an 
Ataospheric  Dispersion  Model  for  Heavier-than-Ai r  Gas  Mixtures' < 

J.  A.  Havens 
T.  0.  Spicer 

University  of  Arkansas 
227  Engineering  Bui Id ins 
Department  of  Chemical  EnSineerins 
Fayetteville*  AR  72701 

April  1985 


This  project  was  sponsored  by  the  U.  S.  Coast  Guard  and  the  Gas 
Research  Institute  under  contract  DT-CG-23-80-C-20029. 


Disclaimer: 

This  computer  code  material  was  prepared  by  the  University  of 
Arkansas  as  an  account  of  work  sponsored  by  the  U.  S.  Coast  Guard 
and  the  Gas  Research  Institute.  Neither  the  University  of  Arkansas* 
nor  any  person  actins  on  its  behalf! 

a.  Makes  any  warranty  or  representation*  express  or  implied* 
with  respect  to  the  accuracy*  completeness*  or  usefulness 

of  the  information  contained  in  this  computer  code  material* 
or  that  the  use  of  any  apparatus*  method*  numerical  model* 
or  process  disclosed  in  this  computer  code  material  may  not 
infrinse  privately  owned  rights!  or 

b.  Assumes  any  liability  with  respect  to  the  use  of*  or  for 
damages  resulting  from  the  use  of*  any  information* 

-  systdegadi s : DEGAOISIN • FOR 
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C 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

C 

c 


apparatus*  Mthodf  or  process  disclosed  in  this  computer 
cod*  aaterial. 


INITIAL  INPUT  FOR  DEGADIS  ROUTINES 

not*!  this  s*ri*s  of  rrosraes  r*li*s  on  th*  sastee  wide 

losical  saefcol  SYS9DEGADIS  which  d*not«s  the  source 
and  executable  code  for  these  i eases. 


PROGRAM  DEGADISIN 


Ieplicit  Real 98  (  A-H,  0-Z  ),  Int*S*rt4  (  I-N  ) 


C 

c 


C 

C 


include  'SYSSDEBADISJdesadisin.dec' 

COMMON 

9/TITL/  TITLE 

9/GEN1/  ET(2,iS*n),RlT<2,is*n) 

9/GEN2/  0EN(Sfis*n) 

9/ITI/  T1,TINP»TSRC»T0BS,TSRT 

9/PARH/  UO,ZO,ZR»NL»USTAR,K»G»RHGE,RHOA»GELTA,BETA,GAMMAF»CeLOW 
»/co*_dProp/  sas.ew r sss.t**p, sss. rhoc » aas_crk , sos-cpp  » 

9  sas_ufl»s*s_lfl»sas_zsp»sas_nae* 

9/eo*_ss/  ess » slen » suidi outcc  » outsz  > outb » out 1 
9/PHLAG/  CHECK 1 , CHECK2 1 AGAIN* CHECK3 , CHECK 4 » CHECK5 
9/coe.siSx/  sisx.coeff »sisx.Pow»sisx.ain_dist»sis>:_flas 
9/NEND/  POUNDN, POUND 

ch#ract*r«80  TITLE(4) 

charact*r93  Sas.teep 
character 94  pound 
charact*r924  TSRC,TINP,TOBS,TSRT 


REAL *8  MLiK 

LOGICAL  CHECK1 » CHECK2 > AGAIN, CHECK3 , CHECK4, CHECKS 


check 1 
ch*ck2*t 
ass  in 
check 3 
ch*ck4*t 


cloud  tape  release  with  no  liouid  source)  SRC1  DEGADIS1 

local  coeeunications  in  SSSUF  SSSUP 

local  coeeunications  between  SRC1  and  NOBL  BEGADIS1 
steadw  state  siaulation  DEGADISIN 


sasSdessdis: DEGADISIN. FOR 
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I'&4 

■*  s 


i$a 


til 


m 


Jilt 


m 


•ft 

*$ 

$ 


w 

0 

W 

m 

*>P 


■ 


c  check 3*t  operator  sets  sort  parameters 


ESTRT3 


data  CHECXl/.false./»CHECK2/.false./*AGAIN/.false./ 
data  CHECK3/ . f al sa . / * CHECX4/ .false./* CHECKS/ .falsa./ 


charactertlOO  OPNRUP 

character  OPNRUP1UOO) 

eoui valance  (opnruPl<l)*opnrup> 

character^  INP*#rlier2*er3*com*scl*sr3*lis 

cheracterM  dummw 

character^  plus 

character <2  con 

DATA  POUND/'//  V*POUNDN/~1.E-20/ 


DATA  ET/iaentO.* isentO. /*RlT/isent0. » isentO./ 
data  DEN/iSentO . * isentO . * isenSO . »i sense . » isentO . / 
DATA  INP/'.INP'/»erl/'.erl'/*er2/'.er2'/*er3/\er3'/ 
data  scl/'.scl'/»sr3/'.sr3'/»lis/'.lis'/ 
data  coa/'.coa'/ 
data  plus/'  +  '/*con/'  -'/ 


CKO  GET  THE  FILE  NAME  TO  BE  USED  BY  ALL  OF  THE  ROUTINES 
C 

«RITE(6»800) 

MRITE(6*810) 

RE  AD  (3. 320)  NCHAR*OPnrup 

opnrup  ■  opnrup (linehar)  //  inr<K4) 

C 

cm  NON  GET  THE  REST  OF  THE  DESIRED  INFORMATION 
C 

CALL  I0T( OPNRUP) 

URITE<6f 1000) 
if<check4>  than 
urite<6*1001)  !  continuous 

else 

if  (uO  .aa.  0.)  than 
«rite<4*100?> 

else 

WRITE(A*1002)  !  transient 

andif 

andif 

write<6*1010) 


cm  FORMATS 
C 

300  FORMAT ( // * 16X  * ' DEnse  GAs  Dispersion  Modal  input  aodula.') 
810  FORMAT!/*'  Enter  the  simulation  naae'* 

»'  :  CDIR3RUNNAME  '*«) 

820  F0RMAT(0fA40) 

1000  FORMAT ( '  '*/* 

•'  In  addition  to  the  inforaation  Just  obtained* '* 
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%'  DEBADIS'*/*'  reauires  a  scries  of  nuaerical  paraaeter'* 

I'  files  which  use' */* '  the'* 

%'  ssae  naae  ss  CDIR3RUNNAME  Siven  above.  '*//* 

S'  For  convenience*  exaaple  paraaeter  files  are  included  for'*/* 
*'  each  step.  They  are!') 

1001  FORMATdOX* ' EXAMPLE. ER1  and'*/*10X» ' EXAMPLE. ER2') 

1002  foraatdOX* 'EXAMPLE.ER1* ' */*10X* ' EXAMPLE. ER2*  and'*/* 

*10X» 'EXAMPLE. ER3') 

1009  foraetdOx* '  EXAMPLE  >ER1') 

1010  foraetd  Note  that  each  of'* 

*'  these  files  can  be  edited  durins  the  course  of  the'*/* 

$'  siaulation  if  a  paraaeter  moves  to  be  out  of  specification.'*/) 


write<6*1200) 

1200  foraatl'  Do  you  want  a  coaaand  file  to  be  senerated  to  execute'* 
t'  the  procedure?  <Y  or  n>  '*$) 

REad(5*1210)  duaaw 
1210  forest <a4> 

if (duaaw. eo. 'n'  .or.  duaay.ea.'N')  Soto  3000 
opnrup  «  opnrupdtnchar)  //  coed  14) 
write<6> 1220)  opnrup 

1220  forest/'  The  coaaand  file  will  be  Senerated  under  the  file'* 

%'  naaet'*/*10x*a40) 

open/ uni t*8*naae»cpnrup* type* 'new ' * 
t  car r i asecont rol*' list' *recordtvpe=' variable ' ) 
c 

opnrup  »  opnrurdlnchar)  //  erl(114) 

write<8*1230)  <opnruPl<i)*ial»nchar+4) 

1230  forest/ '$  copw/Ios  SYSIDEGADISJexaarle.erl  ' >40al ) 

IF(uO  .eo.  0.)  then 
write<8*1280) 

write/8*12?0)  /opnrupl/i)*i*l»nchar) 

Soto  1340 
endif 

opnrup  ■  opnrupdtnchar)  //  er2d!4) 

write/8* 1260)  /opnruPi/i)*i«l*nchar+4) 

1240  forest/ '♦  copw/Ios  3YSlDEGADIS:exaarle.er2  '*40al> 
ornrup  ■  opnrup /lJnchar)  //  er3/lJ4) 

if/.not.checM)  then  !  transient 

write(8*l270)  /opnruPl/i)*i»l*nchar+4) 

1270  forast/'t  copv/Ios  SYStD£BADISIexaapie.er3  '*40al) 

write(8*1280) 

1280  forest/ '•  run  SYSIDEBA0ISJDE0ADIS1 ' ) 

write/8* 1290)  (opnruPl(i)*i«l*nchar) 
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1290 

1300 

1320 


c 


1 


1370 

c 


1390 

else 


c 

1330 


c 


1 


endif 


foreat(40al) 

writ«<3»1300) 

foreatdl  run  SYS*DEGADIS:DE8ADIS2') 
urite(8»  1290)  <ornru»*td)*i«l»nch3r> 
write<8>1320) 

forest* '*  run  SYS*DEGADIS:DEGADIS3'> 
write<8* 1290)  (o*nrunld)»i*l»nchar) 

onnru?  »  omrundtnchar)  //  scld*4)  // 

Musdt3)  //  onnrundJnehar)  //  sr3dt4)  //  cond!2) 
uri te<8»  1370)  ( omrurl  ( i )  >  i*l » 2*nchar+13) 
foreet<'$  eoru/los  '»100s  1) 

onnrun  *  omrurdlnchar)  //  lis(U4) 
uri te<  8r 1390 )  ( ornrur 1 ( i ) > i»l  mcher+4 ) 
format*'  '  ?40il) 

urite<8»1280) 

urite<3rl290)  (ornrurl(i) >i*l>nchar) 
urite<8rl330) 

forest*'*  run  SYS*0£GADIS:SDEGADIS2' ) 
urite*8»1290)  (o*nruj*l<i)>i*l>nchar) 

owrur  *  oenrund inchar)  //  scl(lM)  // 
plus(l’3)  //  ornruedJnchar)  //  sr3dt4)  //  con(lJ2) 
urite*8»1370)  <oenrupl*i)d*l»2*nchar+13) 
omrun  »  oenrurdlnchar)  //  lis(lt4) 
urita(8»t390)  (onnrunl(i)ii»l>nchar+4) 


c 

1340  close*unit«8) 
urit«(4>1330) 

1330  forest*/ t '  Do  uou  uish  to  initiat*  this  procedure?  ' > 
*'  <u  or  N>  'i*> 

REad(3»1210)  dues* 

if (dueev.eo. '»'  .or,  dueeu.eo.'Y')  goto  2000 
Soto  3000 

2000  onnrun  *  'V  //  oenrundJnchar)  //  '  ' 
istat  >  libfdo.coMand(oanrur) 
write<6»2100) 

2100  format*/*'  TDEGADISXN?  coaaand  file  failed  to  start.') 
c 

3000  continue 
CALL  EXIT 
END 

###♦ 
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ROUTINE  TO  SET  RUN  PARAMETERS  FROM  A  FILE 
SUBROUTINE  ESTRTl(OPNRUP) 

Illicit  Rea  US  (  A-H»  0-Z  )»  Intesert4  (  I-N  > 


include  'susBdedadisJDEGADISl.dec' 


1 

1 

1 

1 

1 

1 

1 

1 

1 


iend*  22 1 
iendl*  iend+lF 
iiiend*  2> 
iiiendl*  iiiend+lF 
iiend*  2 » 
iiendl«  iiend+l» 
Jend*  4 > 

Jendl*  Jcndflf 
aend*  5» 
aendl*  aend+1) 


BLOCK  COMMON 
COMMON 

*/ERROR/STPINf  ERBNO  f  STPMXf  WTRGf HTta f WTya f utac f wteb f  w tab  f wtuh  f  XL  I  f 

$  XRIiEPSFZLOUFSTPINZFERBNDZFSTPMXZFSRCOERFsrcssFsrccutF 

%  h tcut f ERNOM.  FNOBLptF erf dePF epsilon 

t/vucoa/  vuSFVubFVucFVudFVudeltaFVuflas 

i/tzfc/  szstpOFSzarrFSzstpaxFSZszO 

t/alphcoa/  i.»lpf  If.jIpco 

$/phieoa/  iphiflidellaa 

$/srrd_con/  c«f  delrhoain 


EQUIVALENCE 

$(RLBUF(1)fSTPIN)f  (MAIN  - 

$<RL3UF(2) fERBND) f  !NAIN  • 

«<RLBUF<3)fSTPMX)f  IMAIN  - 

$<RLBUF(4) fWTRG) f  IMAIN  - 

*(RLBUF(5) FUTta) f  IMAIN  - 

$<RLBUF ( A) f VTua) f  IMAIN  - 

*<RLBUF<7)fMTuc)f  IMAIN  - 

t(RLBUF(3) FUTeb) f  IMAIN  - 

$(RLBUF(9) iWTab) t  IMAIN  - 

«<RLBUFUO>fUTuM)f  IMAIN  - 

«(RLBUF<11)fXLI)»  IALPH  - 

t(RLBUF(12) fXRI) f  IALPH  - 

I(RLBUF(13)fEPS)  IALPH  - 

eaui valence 

f (RLBUF(14) fZLOH) f  IALPHI 

KRLBUF ( 13) fSTPINZ) f  IALPHI 


RKGST  -  INITIAL  STEP  SIZE 
RKOST  -  ERROR  BOUND 
RKGST  -  MAXIMUM  STEP  SIZE 
RKGST  -  HEIGHT  FOR  RG 

RKGST  -  HEIGHT  FOR  Total  aass 

RKGST  -  HEIGHT  FOR  Y» 

RKGST  -  HEIGHT  FOR  Yc 

RKGST  -  HEIGHT  FOR  Energy  Balance 

RKGST  -  HEIGHT  FOR  Moaentua  Balance 

RKGST  -  HEIGHT  FOR  Uefftlleff 

LOWER  LIMIT  OF  SEARCH  FOR  ALPHA 
UPPER  LIMIT  OF  SEARCH  FOR  ALPHA 
ERROR  BOUND  USED  BY  'RTMI* 

-  BOTTOM  HEIGHT  FOR  FIT  OF  ALPHA 

-  INITIAL  RKGST  STEP  <0. 
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c 


c 


C 

c 


c 


*<RL8UF( 16) tERBNDZ) t  I ALPHI  -  ERROR  BOUND  FOR  RKGST 
t<RLBUF<17)»STPNXZ)»  I ALPHI  -  MAXIMUM  STEP  FOR  RK8ST 
$(RLBUF(18) rSRCOFR) ’  ISRCIO  -  OUTPUT  error  criteria 
*<RLBUFU?)>SRCSS).  ISRCIO  -  sin  tiM  for  SteadxMZSTPNX 
•  < RL 9UF (20) f SRCcut ) »  ISRCIO  -  sin  heisht  for  blanket 
f<RL3UF(21)>htcut)r  ISRC1  -  Bin  heisht  for  blanket  Meat  transfer 
KRUBUF<iend)»ERNOBL>»  INOBL  -  CONVERGENCE  CRITERIA 
4<RLBUFi<l)*crfMr)f  ICRFG  -  Error  criteria  for  buildins  tables 
f<RLBUFi(iiiend)fepsilon) ISRCl  -  Coefficient  in  Air  entraineent 


eeui valence 

*(rlbufa<l)»ce)»  ISRCl  -  Coefficient  sravitv  sluerins  EG 
f(RLSUFa<iiend)»delrhonin)  I  stop  spread  for  delrMo<delrhoein 


eouivalence 

»<rlbufl<l)>szsteO)»  I  SZF 
•<rlbufl(2)»szerr)i  I  S7F 
•<rlbufl(3)>szstpex)>  I  SZF 
$(rlbufl(4)»szsz0)  I  SZF 


Initial  step  size 

Error  criteria 

Maxieuo  step  size 

Initial  value  of  rhofdellavZUHeff 


eouivalence 

*<rlbuf4(l)»vus)» 

•( rlbuf4(2) rvub) » 
t<rlbuf4(3)fvuc)» 
i(rlbuf4(4)rvu<t)r 
•< rlbuf4<3) ivudelta) 


I  Constant  Av  in  SRC 2 

I  Constant  Bv  in  SRC1 

I  Constant  Ev  in  SRC1 

!  Constant  Dv  in  SRC 2 

I  Constant  DELTAv  in  SRC 2 


eharacterWO  OPNRUP 
character  DUMNY<1J132) 

DIMENSION  RLBUF(iend).  rlbufiUiiend)  i  rlbufa(iiend) 
dieension  rlbufU Jend) 
dieension  rlbuf4(eend) 


c 

loeical  vuflae 
C 

OPEN ( UN IT-9 » NAME-OPNRUP t TYPE- ' OLD ' >  e  r  r -2000 ) 
C 

Cm  READ  A  LINE  AND  DETERMINE  ITS  PURPOSE 
C 

I  »  1 

100  CONTINUE 

READ<?»1000»END«330>  NCHARr DUMMY 
IF ( DUMMY ( 1 )  .EQ,  'I')  GO  TO  100 
DECODE ( 20 » 1010  » DUMMY  t  ERR-400 )  RLBUF  < I ) 

I  *  I  F  1 

if (i  .bo.  iendl)  soto  110 
GO  TO  100 


110  CONTINUE 

READ  <9*1 000 * END-330 )  NCHAR  *  DUMMY 
2  —  svsf desadi s l ESTRT 1 .  FOR 
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IF(DUMHYd)  .EQ.  '!')  GO  TO  110 
DECODE ( 20 1 101 0 » DUMMY t ERR»400  >  Ptnobl 
NOBLPT  »  INT(PTNOBL) 

I  «  1 

120  CONTINUE 

R£AD<9f 1000»£ND*3SO)  NCHA*»DUMMY 
IF(DUWIYd)  .EQ.  '!')  GO  TO  120 
KCODE<20»1010fDUMHY>ERR*400)  RLBUFi(I) 

I  «  I  +  1 

ifd  »m.  iiiandl)  soto  140 
GO  TO  120 
C 

Cm  READ  A  LINE  AND  DETERMINE  ITS  PURPOSE  for  /sprd.con/ 

C 

140  I  *  1 
ISO  CONTINUE 

R£AD(9»1000f£ND*350)  NCHAR» DUMMY 
IF(DUMNYd)  .EQ.  dd  60  TO  ISO 
DEC0DE(20»1010»«JMMY»ERR»4O0)  RLBUFa(I) 

I  «  I  +■  1 

ifd  .m.  iiandl)  3oto  190 
GO  TO  ISO 
C 

Cm  REAO  A  LINE  AND  DETERMINE  ITS  PURPOSE  to  fill  szfc 
C 

190  I  «  1 
200  CONTINUE 

R£AD(9> 1000»£ND*3SO)  NCHAR> DUMMY 
IF<DUHMY(1)  .EQ.  '!')  GO  TO  200 
DECODE (20*1010» DUMMY > ERR“400 )  RLBUFl(I) 

I»If  1 

ifd  .to.  J*ndl)  3oto  230 
GO  TO  200 
e 

Cm  READ  A  LINE  AND  DETERMINE  ITS  PURPOSE  to  fill  /ali»hco»/ 
C 

230  I  «  1 
240  CONTINUE 

R£AD<9»1000>END*330)  NCHARi DUMMY 
IF(DUNHYd)  .EQ.  'I')  GO  TO  240 
DECODE (20 *1010* DUMMY »ERR«400>  Ralpfl 

ialpfl  »  int(ralpfl) 

2S0  CONTINUE 

READ<9»1000f END-330)  NCHAR» DUMMY 
IF(DUMMYd)  .EQ.  '!')  GO  TO  250 
DECQDE< 20 »1010» DUMMY >ERR*400)  alpco 
c 

Cm  READ  A  LINE  AND  DETERMINE  ITS  PURPOSE  to  fill  ->hicoa/ 

3  --  svs$0««adi*:ESTRTl.F0R 


240  I  *  1 
270  CONTINUE 

READ (9i 1000 i END* 3S0)  NCHARiDUNNY 
IF<DUHHY(1)  .EQ.  '!')  CO  TO  270 
DECODE (20 >  1010 f DUMNY » £RR*400 )  Rphifl 

iphifl  *  int(rphifl) 

275  CONTINUE 

R£AD(9i1000iEND*350)  NCHARiDUNNY 
IF(DUNNYd)  .EQ.  '!')  GO  TO  273 
DECODE < 20 » 1010 1 DUMNY , ERR MOO )  dalla* 
c 

CSSS  READ  A  LINE  AND  DETERNINE  ITS  PURPOSE  to  fill  /vucoa/ 
C 

280  I  *  1 
290  CONTINUE 

READ(9i1000iEND*330)  NCHARiDUNNY 
IF(DUNNYd)  .EQ.  '!')  GO  TO  290 
DECODE ( 20 »1 01 OiDUNNYiERR*400>  RLBUF4(I) 

I  a  I  +  1 

if<i  .m.  Mndl)  aoto  300 
GO  TO  290 
e 

CSSS  EXIT  THE  PROCEEDINGS 
C 

300  CONTINUE 

CL0SE(UNIT*9) 

RETURN 

c 

330  call  trap(20) 

C 

400  CONTINUE 

CALL  trap (21) 

C 

1000  F0RNAT(Q|132A1) 

1010  F0RNAT(10XiGl0.4) 

C 

2000  call  trap(22) 

END 

ms 


4  —  ***$dadadis JESTRT1 .FOR 


ROUTINE  TO  (JET  RUN  PARAMETERS  FROM  A  FILE 
SUBROUTINE  ESTRT2(0PNRUP) 

Illicit  R«al*8  (  A-H»  O-Z  )»  InteasrM  (  I-N  ) 


include  ' sa*$d»sadis: DEGABIS2 . dec/list ' 

parameter  (  ienda=  18» 

1  iendal=  ienda+li 

2  iendb3  7» 

3  iendbl9  iendb+1 ) 

coaaon 

4/ERR0R/SY0ER  t ERRO » SZOER » UTAIO  >  WTOOO t HTSZO  >  ERRP » SMXP  t 
i  HTSZP t UTSYP , WTBEP » HTDH i ERRO . SMXG  t ERTDNF » ERTUPF » WTRUH » HTDHG 
$/STP/STPO ,  STPP » ODLP  *  ODLi-P  >  STPS » OBLG  *  ODLLG 
l/CNQBS/NOBS 

EQUIVALENCE 

*(RLBUF(1) »SYOER) »  ISSSUP  -  RKGST  -  INITIAL  SY 
*(RLBUF(2)»ERR0)»  ISSSUP  -  RKGST (OBS)  -  ERROR  BOUND 

* ( RLBUF ( 3) » SZOER ) »  ISSSUP  -  RKGST (OBS)  -  INI UAL  SZ 

$(RLBUF(4) »HTAIO) »  ISSSUP  -  RKGST (OBS)  -  HEIGHT  FOR  AI 

*(RLBUF(3),HTQ00)»  ISSSUP  -  RKGST (OBS)  -  HEIGHT  FOR  Q 

$(RLBUF(6) >HTSZO) »  ISSSUP  -  RKGST (OBS)  -  HEIGHT  FOR  SZ 

$(RLBUF(7)»ERRP) >  ISSSUP  -  RKGST(PSS)  -  ERROR  BOUND 

$(RL3UF(8) »SMXP) »  ISSSUP  -  RKGST(PSS)  -  MAXIMUM  STEP 
* (RLBUF (9) r HTSZP )»  ISSSUP  -  RKGST(PSS)  -  HEIGHT  FOR  SZ 

*(RLBUF(10)fHTSYP)f  ISSSUP  -  RKGST(PSS)  -  HEIGHT  FOR  SY 

f (RLBUF(ll)  »HTBEP)»  ISSSUP  -  RKGST (PSS)  -  HEIGHT  FOR  BEFF 

$(RLBUF( 12) iHTDH) t  ISSSUP  -  RKGST(PSS)  -  HEIGHT  FOR  DH 

$(RL8UF(13)»ERRG)»  ISSSUP  -  RKGST (SSG)  -  ERROR  BOUND 

*(RL8UFU4)>SMXG)»  ISSSUP  -  RKGST ( SSG )  -  MAXIMUM  STEP  SIZE 
$  <  RLBUF <  1 5 )  >  ERTDNF ) ?  ITDNF  -  CONVERGENCE  CRITERIA 
l(RLBUF(l£)»ERTUPF)»  ITUPF  -  CONVERGENCE  CRITERIA 
«(RL8UF(17)»HTruh)>  ISSSUP  -  RKGST ( SSG )  -  HEIGHT  FOR  RUH 

I (RLBUF ( ienda) f HTdha) I SSSUP  -  RKGST (SSG)  -  HEIGHT  FOR  DH 

EQUIVALENCE 

* ( RLBUF 1 ( 1 )  > STPO ) t  ISSSUP  -  RKGST (OBS)  -  INITIAL  STEP 

t(RLBUFl(2) »STPP) t  ISSSUP  -  RKGST(PSS)  -  INITIAL  STEP 

$(RLBUF1<3) >0DLP) »  ISSSUP  -  RKGST(PSS)  -  RELATIVE  OUTPUT  DELTA 
XRL8UFH4) fODLLP) >  ISSSUP  -  RKGST(PSS)  -  MAXIMUM  DISTANCE  TO  OUT 

XRLBUFX3)  >STPG) »  ISSSUP  -  RKGST (SSG)  -  INITIAL  STEP 

$(RLBUF1(6) fODLG) t  ISSSUP  -  RKGST (SSG)  -  RELATIVE  OUTPUT  DELTA 
*<RLBUFl(iendb)> ODLLG) ISSSUP-  RKGST (SSG)  -  MAXIMUM  DISTANCE  TO  OUT 


-  sas4d«aadis*ESTRT2.F0R 


charactar*40  QPNRUP 
charactar  duaa*(i:i32> 

DIMENSION  RLBUF(ianda) ,RLBUFl(iandb> 

C 

OPEN  <  UNIT*? » NAME*OPNRUP , TYPE* ' OLD ' ) 

C 

cm  FIRST,  FILL  RLBUF 
C 

cm  READ  A  LINE  AND  DETERMINE  ITS  PURPOSE 
C 

I  *  1 

100  CONTINUE 

R£AD<?,1000»£ND*300)  NCHAR » DUMMY 
IF ( DUMMY <  1 )  .EQ.  '!')  60  TO  100 
DECODE  <  20 * 1 01 0 , DUMMY  »ERR*400)  RLBUF ( I ) 
1*1  +  1 

IF (I  .ED.  iendal )  60  TO  200 
60  TO  100 
C 

cm  NOW*  FILL  RLBUF  1 

C 

200  I  *  1 
210  CONTINUE 

READ <7,1000, END* 300 )  NCHAR, DUMMY 
IF ( DUMMY ( 1 )  .EQ.  '!')  60  TO  210 
DEC0DE(20t  1010f  DUH/fTt ERR»400>  RUMJFUI) 
1*1  +  1 

IF < I  .EQ.  iandbl)  60  TO  260 
60  TO  210 
C 

cm  NOW*  PICK  UP  NOBS 
C 

260  CONTINUE 

READ (?, 1000, END* 300)  NCHAR, DUMMY 
IF<DUMMY(1)  .EQ.  '!')  30  TO  260 
DECODE120, 1010, DUMMY, ERR*400)  RBUF 
NOBS  »  INT(RBUF) 

C 

cm  EXIT  THE  PROCEEDINGS 

C 

CLOSE (UNIT*?) 

RETURN 

C 

300  call  traa(20) 

400  CALL  traa<21) 

C 

1000  F0RMAT(Q,132A1) 

1010  FGRNAm0X,G10.4> 

END 

***♦ 
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C 

c 

c 

c 


ROUTINE  TO  GET  RUN  PARAMETERS  FROM  A  FILE 
SUBROUTINE  ESTRT2SS(0PNRUP) 


Illicit  Resits  (  A-H.  0-Z  ),  Intesfer*4  (  I-N  ) 


c 

include  'sss*deSadis{BEGadis2. dec/list' 
c 

f>araeeter(  ienda*  18. 

1  iendal*  ienda+l. 

2  iendb-  7. 

3  iendbl*  iendb+1) 

C 

COMMON 

i/ERROR/SYOER » ERRP . SMXP  > UTS2P , HTSYP » WTBEP » WTDH , ERRG , SMXG  r 
t  UTRUH.WTDHG 

i/STP/STPP » ODLP » ODLLP *  STPG » ODLG » ODLLG 
C 
c 

character *40  OPNRUP 
character  DUMMY (1J 132) 

DIMENSION  RLBUF(ienda) . RLBUF 1 ( iendb) 

C 

OPEN(UNIT*?.NAME=OPNRUP»TYPE*'OLB' ) 

C 

cm  FIRST.  FILL  RL5UF 
C 

Cm  READ  A  LINE  AND  DETERMINE  ITS  PURPOSE 
C 

I  *  1 

100  CONTINUE 

READ < 9 ? 1000 . END* 350 )  NCHAR. DUMMY 
IF(DUMMY(t>  .EQ.  '!')  GO  TO  100 
DECODE (20.1010. DUMMY , ERR-400  )  RLBUF ( I ) 

1*1  +  1 

IF(I.EQ.  iendal)  GOT0200 
GO  TO  100 
C 

Cm  NOW.  FILL  RLBUF  1 
C 

200  i  *  1 

210  READ(9. 1000. END-350)  NCHAR. DUMMY 
IF(DUMMYU)  .EQ.  '!')  GO  TO  210 
DECODE (20.1010. DUMMY » ERR-400 )  RLBUF 1(1) 

1*1  +  1 

if(i.eo.  iendbl)  Soto  300 
GO  TO  210 
C 
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CW»  EXIT  THE  PROCEEDINGS 
C 


300  CONTINUE 

**Oar  *  rlbuf(l)  ISSSUP  -  RK6ST  -  INITIAL  ST 
•rr*  •  rlbuf(7)  ISSSUP  -  RKGST<PSS)  -  ERROR  BOUND 

sax*  »  rlbuf (8)  ISSSUP  -  RKGST(PSS)  -  MAXIMUM  STEP 

»  rlbuf (9)  ISSSUP  -  RKGST(PSS)  -  HEIGHT  FOR  SZ 
utsx*  «  rlbuf (10)  ISSSUP  -  RKGST(PSS)  -  WEIGHT  FOR  ST 

ut ba*  »  rlbuf(ll)  ISSSUP  -  RKGST(PSS)  -  WEIGHT  FOR  BEFF 

wtDH  *  rlbuf (12)  ISSSUP  -  RKGST(PSS)  -  WEIGHT  FOR  BEFF 

area  »  rlbuf (13)  ISSSUP  >  RKGST(SSG)  -  ERROR  BOUND 

sax*  *  rlbuf (14)  ISSSUP  -  RKGST(SSG)  -  MAXIMUM  STEP  SIZE 

utRUH  *  rlbuf (17)  ISSSUP  -  RKGST(PSS)  -  WEIGHT  FOR  BEFF 

wtDHG  »  rlbuf (18)  ISSSUP  -  RKGST(PSS)  -  WEIGHT  FOR  BEFF 

C 

stw»  *  rlbufl(2)  ISSSUP  -  RKGST(PSS)  -  INITIAL  STEP 

odlP  »  rlbuf 1(3)  ISSSUP  -  RKGST(PSS)  -  RELATIVE  OUTPUT  DELTA 

odll*  »  rlbufl(4)  ISSSUP  -  RKGST(PSS)  -  MAXIMUM  DISTANCE  TO  OUT 

stM  »  rlbuf 1(3)  ISSSUP  -  RKGST(SSG)  -  INITIAL  STEP 

odld  -  rlbuf 1(4)  ISSSUP  -  RKGST(SSG)  -  RELATIVE  OUTPUT  DELTA 

odlld  a  rlbufl<7)  ISSSUP  -  RKGST(SSG)  -  MAXIMUM  DISTANCE  TO  OUT 

C 

CLOSE(UNlTa?) 

RETURN 

C 

330  call  tra*<20)  I  preaatur*  EOF 
c 

400  CALL  tra*(21) 

C 

1000  FORMAT(Q»  132A1 ) 

1010  F0RMAT(10X*G10.4) 

C 


END 

#♦ 
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ROUTINE  TO  SET  RUN  PARAMETERS  FROM  A  FILE 
SUBROUTINE  ESTRT3(0PNRUP> 

Illicit  Real*8  (  A-H»  0-Z  )t  IntM«rt4  (  I-N  ) 

C 

COMMON 

4/PHL AG/CHECK 1 » CHECK2 » A6AIN » CHECX3 1 CHECK4 1  CHECKS 
$/co«.s i ax/  siax_cotf f >  s i sx_pow » s i ix_ain_di at  > s isx_ f 1 ad 
4/ERROR/ERT1 »ERDT  t ERNTIM 
C 

EQUIVALENCE 

$<RLBUF(1)»ERT1).  'FIRST  SORT  TIME  -  USER  OPTION 
«(RLBUF(2)»£RDT)»  (SORT  TIME  DELTA  -  USER  OPTION 

S(RLBUF< 3) 'ERNTIM)  ! NUMBER  OF  SORT  TIMES  -  USER  OPTION 

C 

LOGICAL  CHECK 1 1 CHECX2 1 AGAIN ' CHECX3 ' CHECK4 1 CHECKS 
character  DUMMY(1U32) 
char acta r*40  ornrur 
DIMENSION  RLBUF(3) >RBUF(6) 

C 

OPEN  <  UN I T=9 » NAME *OPNRUP » TYPE3 'OLD' ) 

C 

C*«  READ  A  LINE  AND  DETERMINE  ITS  PURPOSE 
I  3  1 

100  CONTINUE 

READ( 9' 1000'END3300>  NCHAR'DUMMY 
IF(DUMMY(1)  .EQ.  '»')  SO  TO  100 
DEC0DE(20fl010'DUMMY'ERR3400)  RBUF<I) 

1  =  1  +  1 
GO  TO  100 
C 

cm  EXIT  THE  PROCEEDINGS  AND  DETERMINE  CHECKS 
300  CONTINUE 
C 

DO  310  I  3  1»3 
310  RLBUF(I)  3  R8UF(I) 

CHECK5  3  .FALSE.  !  IN  ORDER  FOR  FLAG  TO  WORK 

IF(RBUF<4)  .EQ.  1.)  CHECKS  3  .TRUE. 


sidx-flad  3  rbuf(S) 
CLOSE' UNIT3?) 

RETURN 

C 

400  CALL  traa(21) 

1000  FORMATS' 132A1) 

1010  F0RMAT(10X»810.4) 
END 

*444 
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SUBROUTINE  GAMMA 


C 

. . . . . . . . . . . 

e 

c  This  routine  mm  orisinall*  supplied  bv  Digital  Eauipwnt 
c  Corporation  as  part  of  tha  Scientific  Subroutine  Packase 

c  available  for  RT-11  n  part  of  the  Fortran  Enhancement 

c  Packase.  It  was  upsraded  for  use  in  this  packase. 
c 

. . . . . . 


PURPOSE 

COMPUTES  THE  GAMMA  FUNCTION  FOR  A  GIVEN  ARGUMENT 
C 

C  USAGE 

C  GF  >  GAMMA(XX) 

C 

C  DESCRIPTION  OF  PARAMETERS 

C  XX  -THE  ARGUMENT  FOR  THE  GAMMA  FUNCTION 

C 

C  IER-RESULTANT  ERROR  CODE  WHERE 

C  IER*0  NO  ERROR 

C  IER»1  XX  IS  WITHIN  .000001  OF  BEING  A  NEGATIVE  INTEGER 

C  IER-2  XX  GT  34.3*  OVERFLOW 

C  IF  IER  .NE.  0  PROGRAM  TAKES  A  DIP  IN  THE  POOL! 

C 

C  REMARKS 

C  NONE 

C 

C  SUBROUTINES  AND  FUNCTION  SUBPROGRAMS  REQUIRED 

C  NONE 

C 

C  METHOD 

C  TIC  RECURSION  RELATION  AND  POLYNOMIAL  APPROXIMATION 

C  BY  C. HASTINGS* JR.*  'APPROXIMATIONS  FOR  DIGITAL  COMPUTERS'* 

C  PRINCETON  UNIVERSITY  PRESS*  1?53 

C 

C  MODIFIED  TO  FUNCTION  FORM  FROM  ORIGINAL  SUBROUTINE  FORM 

C 

C  . . . . . . 

c 

FUNCTION  GAMMA(XX) 

ISPlicit  RealSS  (  A-H*  0-Z  )*  InteSerM  (  I -N  ) 

IF(XX-34.3)4*4*4 
4  IER-2 
GAMMA*  1  .E38 
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80  TO  1000 
6  X»XX 
ERR*1.0E-6 
IER-0 
GAMMA-1.0 
IF<X-2.0)50»50fl3 
10  IF<X-2.0)110»U0»15 
15  X-X-1,0 

GAMMA-GAMMAtX 
80  TO  10 

50  IF(X~1 .0)60* 120* 110 

C 

:  SEE  IF  X  IS  NEAR  NEGATIVE  INTEGER  OR  ZERO 

60  IF(X-ERR)62*62>80 
62  Y=FLOAT<INT(X))-X 

IF(ABS(Y)-£RR)130>130»64 
64  IF < 1 .O-Y-ERR) 130» 130» 70 

X  NOT  NEAR  A  NEGATIVE  INTEGER  OR  ZERO 

70  IF(X-1,0)80.80>110 
80  GAMMA-GAMMA/X 
X-X+1.0 
GO  TO  70 
110  Y-X-1.0 

G  Y- 1 . 0+ Y*<  -0 . 5771 01 7+Yt  <  +0 , 9858540+ Y* ( -0 . 87642 1 8+ Yt 
I ( +0 . 3328212+ YX ( -0 . 3684729+ Y* <  +0 . 2548205+ Y* (-0.051 49930 ) >))))) 
GAHMA«0AMHA*8  Y 
120  RETURN 
130  IER-1 
1000  CONTINUE 

IF(IER.EO.l)  WRITE(SrllOO) 

IF(IER.EQ.2)  NRITE(3f 1110) 

1100  FORMAT <3X» 'TGANMA? — ARGUMENT  LESS  THAN  0,000001') 

1110  FORMAT (5X» 'TGAMMA? — ARGUMENT  GREATER  THAN  34.5— OVERFLOW' ) 
CALL  EXIT 
END 
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c 

C  SUBROUTINE  TO  ESTABLISH  THE  TINE  SORT  PARAMETERS 
C 

SUBROUTINE  6ETTIM 

Illicit  RealS8  (  A*Hi  O-Z  )»  InteiertA  (  I-N  ) 
c 

include  'sys*desadis:DEGADIS3. dec/list' 

C 

COMMON 

«/SSCON/  NREC(eaxnob*2)*T0(»axnob)*XV<eaxnob> 
l/SORTIN/  TIM<ajxnt)*NTIM*ISTRT 
l/PARMSC/  RM*SZM*EMAX*RMAX*TSC1*ALEPH*TEND 
S/PHLAG/  CHECK 1 * CHECX2 1 AGAIN » CHECK3 * CHECK 4 *  CHECKS 
S/ERROR/  ERT1 » ERBT * ERNTIM 
*/AIJ>/  ALPHA* alehal 
f/CNOBS/  NOBS 
C 

LOGICAL  CHECK 1 » CHECK2 * CHECX3  *  CHECK4  *  CHECKS  *  A6A I N 
C 

DATA  TI/0./»DT/0./*TF/0./ 

C 

C»«  IF  CHECKS  IS  SET*  GET  THE  TIME  SORT  PARAMETERS  FROM  /ERROR/ 

C 

IF<  <NOT. CHECKS)  GO  TO  90 
C 

T1  »  ERT1 
DT  *  ERBT 

NTIM  »  INT(ERNTIM) 

GO  TO  9S 
C 
C 

CSSS  This  subroutine  sets  the  default  tine  sort  windows. 

C 

Cm  The  first  sort  tine  is  set  for  potential  low  wind  speed  cases* 
Cm  while  the  last  sort  tiee  is  set  for  potential  hish  wind  speed 
Cm  cases*  The  first  sort  tiee  is  taken  to  be  when  the  first 

Cm  observer  passes  throush  x«RMAX.  The  last  sort  tise  is  taken 

Cm  to  be  when  the  last  observer  passes  throush  x*6SRMAX. 

CSSS  The  default  value  for  the  nuaber  of  sort  tiees  is  set  to  10. 
CSSS  Obviouslw*  these  values  Senerate  soae  sort  tines  which  will  be 

CSSS  useless!  hopefully*  these  values  will  show  the  user  where  to 

CSSS  look  on  the  next  so  around. 

C 

90  CONTINUE 
C 

T1  »  T0<1)  ♦  (2.SRMAX)SS(1  ./ALPHAD/ALEPH 
TF  «  TO(NOBS)  ♦  (4. SRMAX)SS(1. /ALPHAD/ALEPH 
NTIM  »  10 
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)•$ 

k 


$ 

I 

*•*! 


(,u 

ii<j 

» 


DT  ■  < TF-T1) /FLOAT ( NT IM-1) 

DT  *  FLQATdNT<DT+,5) ) 

IF(DT  .GE.  5.)  SO  TO  95 
DT  *  3. 

NTIM  ■  IMT((TF  -  T1)/DT)  +  1 


93  CONTINUE 


T1  »  FLOAT(INT(Tl) ) 


'MAKE  T1  AN  INTE8ER  VALUE 


I 

|*I'| 


DO  100  I  ■  1»NTIM 
TIH(I)  »  DTtFLOAT(I-l)  f  T1 
100  CONTINUE 

RETURN 

END 


l:d 


I 


li 


a 


*‘."G 

1 

lU 


1 

.J 

A 
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SUBROUTINE  H£AD<*mssO> 


Illicit  Real*8  (  A-H*  0-Z  )>  Inteser*4  (  I-N  ) 

C 

include  'sy*$d#aadi*:DEGADISl.dec' 
include  ' (t**def)' 
c 

common 

I/GEN3/  RABG(2*eexl)*GSTR(2>aexl)*srcden(2*aaxl)  »srcuc(2?aaxl)» 
f  srcwa<2»aexl)**rcenth(2*Baxl) 

%/mi/  TITLE 

4/GEN1/  ET(2*iden) >RlT(2*isen) 

4/GEN2/  10(3*  i  Jen) 
i/ITI/  T1»TINP*TSRC»T0BS*TSRT 

* /ERROR/  STP IN  *  ERBHO  * STPHX >  UTR6  *  UT  ta  *  UTaa  *  uty c  *  wteb  * w tab *  wtuh  *  XL I  * 

*  XRI*EPS* ZLOU » STPINZ* ERSNOZ t STPMXZ*  SRCOER*  sress  * s recut * 
t  htcutiERNOBL*NOBLrt*crfaer*eMilon 

$/PARH/  UO  *  ZO  *  ZR  *  ML  *  USTAR • K  *  6  *  RHOE  >  RHOA  *  DELTA  >  BETA  *  GAMMAF • CcLOW 
l/coe_Sr roe/  Ja*_*u*ias_ teirijii. rhoe *  3a  « _e?k  > jas-cee * 

*  aas.uf 1  *  das.lf 1 *4as.zse*  3a*_naae 

•/coaata/  istab* taab*eaab*huaid* isof 1  *  tsurf * ihtf 1 >  htco* iwtf 1  * wteo 
1/coa.ss/  eis*slen*suid*outcc>outsz*outb*outlf sucl*swal*jenl»srhl 
$/rhla3/  check 1 *  check2  >  aaai  n  *  check 3  *  check 4  *  check 5 
t/NEND/  POUNDN. POUND 
3/ALP/  ALPHA *alj»hal 
♦/alrhcoe/  ialefl*aleco 
•/rhicoa/  irhifl, della* 
t/serd_con/  ce*  delrhoain 
c 

eharacterttJO  TITLE (4) 
c 

characterM  round 
character*24  TINP*TSRC*TOBS*TSRT 
eharacter*3  Jas.naee 
charactertl  *tabil<4) 
character*24  id 
c 

logical  check 1 *check2*a3ain*check3*check4*check5 
c 

REALI8  K*«L 

c 

data  stabil/'A'f'B'f'C'f'D'f'E'f'FV 
data  tear a/0/ 

C 

if(irars  *eo.  1)  joto  1?0 
WRITEC8* 1100) 

1100  FORMAT (1H0>  'U  OA.DEGADIS  '* 

«2X*'N  0  D  E  L  ' *2X* '0  U  T  P  U  T  '*2Xr'-  -  '*2X*'V  E  R  S  I  0  N  '* 

*2X  * ' 1 . 2 ' *  8X  * ' Tttttttttttttttttttt ' ) 


1 
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HRITE(8»1111) 

* 

WRITE<8»1102)  tsrc 

1102  ih  »' iiwootom 

% ' »»»»»«»« '  1 23X  t  ’  ttttttttttttttt ' ) 


0 


URITE(8»1111) 

C 

URITE(8f 1112)  TINP 
URITE(8»1114)  TSRC 

IF(tOBSd:2).NE.'  '  .and.  ,not.check4)  WRITE(8f1116)  TOBS 
IF(tOBS(i:2) .NE. '  '  .and.  check*)  WRITE(8dll7)  TOBS 

IF(tSRTd.2)  .NE.  '  ')  WRITE(8»1118)  TSRT 

1112  FORMAT <  1H  »'Data  ineut  on'r22Xia24> 

1114  FORMATdH  » 'Source  rrosraa  run  on'»14X»a24) 

1116  FORMATdH  t 'Pseudo  Steady-State  prosraa  run  on  '»a24) 

1117  FORMATdH  i 'Steady-State  rrodraa  run  on'»7::ta24) 

1118  FORMATdH  »'Tiae  sort  rrodraa  run  on'»llX»a24) 

HRITE<8t  1111) 

C 

«rite<8.1119) 

HIP  foraat(//r 

llh  »10x»22< '*»**')»/. 

21Jl  rlOxt 't*  rtl21r 't' t/t 

31h  »10x»'*'»t20f 'NOTE.' »tl21> '*'»/» 

21h  »10x»'t'ft20»' - '»tl21»'*'»/» 

21h  »10x»'*'»tl21f '*'»/» 

21h  t 10x» '*'*t20» '>' *t23» 'All  Calculations  are  lia'» 

3'ited  to  circular  liouid  sources. '»tl21» '*'»/» 

21h  »10x»'*'»tl21i '*'./* 
llh  fl0xf22<'mw')»//) 

URITEOdllO) 

URITE(8* 1111) 

C 

1110  FORMATdHOflOX*' TITLE  BLOCK' ) 

1111  FORMATdH  ) 

C 

20  100  I  *  1»4 
HRITE(8fll20)  TITLE(I) 

100  CONTINUE 
C 

1120  FORMATdH  >A80) 

C 

WRITE(8f1111) 

WRITE(8» 1130)  UO 
WRITE<8* 1140)  ZO 
HRITE(8f 1130)  ZR 
write<8»1153)  stabildstab) 

URITE(8» 1160)  ML 
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URITE(3» 1170)  DELTA 
URITE(8rll80)  BETA 
WRITE<8*1190)  ALPHA 
WRITE<8rll92)  USTAR 
URITEOf  1191)  t aab 

ifdsofl.ee.O  .and.  ihtfl.ne.O)  write<8»1195)  tsurf 
WRITE<8»1196)  raab 
«RITE<8»1198)  huaid 

vaeore  »  6.02?8e-3*  exr<5407.*  (1./273.15-  l./taab))  !  ata 
relhuaid  »  100. t  humid/ (0.622*varorr  /  (rsab-  v»opp)) 
write<8>1199)  relhuaid 

t 

1130  FORMAT ( 1H  »5X»'Wind  velocity  at  reference  height  ' »20X»FA.2»2Xf 
•'a/s' ) 

1140  FORMAT ( 1H  »5X> 'Reference  height  '.37X»F6.2»2X»'a') 

1150  FORMAT ( lHOrSXf ' Surface  roughness  length  ' »25X»1PG10.3»2X» 'a' ) 
1155  FORMAT! 1H0>5X> 'Pasouill  Stability  class  '»25X»4x»al) 

1 160  FORMAT ( lHOrSX* 'Mon in-Obukhov  length  ' »29X> 1PG10.3.2X. 'a' ) 

1170  FORMATdH  »5X» 'Gaussian  distribution  constants  '»4X» 'Delta'* 
•10X»F9.5»2X»'a') 

1180  FORMATdH  *5X*32X*4X* 'Beta' * 11X»F9.5) 

1190  FORMATdHOr5Xr'Uind  velocity  rower  law  constant' »4Xf'Alrha'» 
•10X»F9.5) 

1192  FORMAT ( 1H  »5Xi 'Friction  velocity' »15X»4X»5X»10X»F9.5»2X* 'a/s') 

1194  FORMAT dH0f5X»'Aabient  Teaeeratur*  ' *33X*F6.2»2X» 'K' ) 

1195  F0RMAT<1H0.5X» 'Surface  Teaeerature  '»35X»F6.2»2X» 'K') 

1196  FORMATdH  *5X»'Aabient  Pressure  '.37X»F6.3»2X*'ata') 

1198  FORMATdH  »5X»'Aabient  Absolute  Huaidity'*2SX»lPG10.3*2X, 

$ 'kg/kg  BOA') 

1199  FORMATdH  »5X» 'Aabient  Relative  Huaidity' *25X,4X,F6.2*2X, 'X' ) 

» 

URITE<8»1111) 

ifdsofl  .eo.  0)  goto  135 
URITE(8t 1200) 

WRITE <8. 1205) 
ii  *  -1 

DO  130  I  *  liigen 
IF(DENd'I)  .gt.  1.)  SoTO  148 
ii  ■  ii+1 
ifdi.ee.  3)  then 

write(8»1211) 
ii  »  0 
end  if 

130  WRITE(8rl210)  DENd.I) » DEN < 2 » I )  »den(3ti) 
goto  148 

135  write<8*1207) 
write<8»1208) 
ii  »  -1 

DO  138  I  *  liigen 
IF(D£Ndi I).gt.  1.)  soTO  148 
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ii  *  ii+1 
ifdi.ee.  3)  then 

write<8»1211) 
ii  ■  0 
endif 

HRITE(8#1212)  DENd#I)»DEN<2»I>#den<3»i)»den<4»i)#den<5#i) 
continue 


FORHATdH  »5X»'Innut!  >6X»3x#  'Mole  fraction'»4x» 

1  'CONCENTRATION  OF  C'»6X#'GAS  DENSITY' ) 

FORMAT < 1H  #14X»20x»2d3X»'lu/B<*3')) 

FORMAT (1H  »5X» 'Adiabatic  Mixins! ' »3x» 'Mole  fraction' »3x» 

1  'CONCENTRATION  OF  C'.6X»'GAS  DENSITY' »3x» 

1  6x»  'Enthalrw'  #6x#1x»  'Tearerature' ) 

FORMATdH  #14X#20x#2d3X#  'kS/eS*3' ) »7x»8x» ' J/kS' »8x#9x>  'K' ) 
FORMAT ( 1H  »14X»3d2X»F8.5>) 
forest  dH  ) 

FORMAT ( 1H  *14X»3d2X»F8.5)»6x>3x.lrSl3.3f7x>lMl3.5) 


URITE(8f 1111) 

WRITE (8# 1220)  UitiO 
WRITE(8» 1230) 


DO  ISO  I-l.IQEN 

IF(R1T(1»I).EQ.R0UNDN  .AND.  R1T(2»I) .EQ.POUNDN)  GO  TO  160 
WRITE<8#1240)  ETd#I) »£T<2»t) #R1TC2#I) 

CONTINUE 


FORMAT ( 1H  » 'Source  innut  data  points' »//» 

1  lh  >13x» 'Initial  eass  in  cloud!  '»1m13.3»//» 

1  lh  >24xf8X» 'TIHE'rlOXr 'SOURCE  S'# 

2  'TREN0TH'.6X»' SOURCE  RADIUS') 

FORMAT ( 1H  »34X» 's' > 17X# 'ks/s' » 18X# 'a' ) 

FORMAT ( 1H  »24X»3<1X#1PQ12.3»4X)) 

foreatdhO»5x» 'Calculation  procedure  for  ALPHA!  '#12) 
foraatdh0#5x# 'Entrainaent  prescription  for  PHI!  '#12) 
for«at(lh0#3x# 'Laver  thickness  ratio  used  for  averase  depth!  '» 

1  1ps13.5> 

forastdhO#Sx# 'Air  entraineent  coefficient  used!  '»fS.3) 
forest dhO#Sx# 'NON  I so the r sc 1  calculation') 

foraatdhOrSxi 'Gravity  sluenin*  velocity  coefficient  used!  '»fS.3) 
forestdhO»5x#'H*at  transfer  calculated  with  fixed  coefficient!  '# 

1  1PS13.5#'  J/e*S2/s/K ' ) 

forest (lh0#5x# 'Heat  transfer  not  included') 
foreatdhO#Sx#'Heat  transfer  calculated  with  correlation!  '#12) 
forest dh0»3x» ' Isotherasl  calculation' ) 

foraatdhO»5x» 'Hater  transfer  calculated  with  fixed  coefficient!  ' i 
1  1PS13.3#'  /e**2/s/ate') 

foreatdhOfSx# 'Hater  transfer  not  included') 
foraatdh0#5x# 'Hater  transfer  calculated  with  correlation') 
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URITE(8rllll) 
write<8tl241)  ialrfl 
write<8>1242)  irhifl 
write(B>1244)  dellae 


write<8rl250)  ersilon 
w rit*(3fl252)  ce 
ifdsofl.ee.  0)  write<8il23l) 
ifdsofl.ne.  0)  write(8»1236) 


ifdhtfl.lt.  0)  writeO.  1233)  htco 
ifdhtfl.ee.  0)  write<8»1234) 
ifdhtfl.it.  0)  write<8»1233)  ihtfl 
ifdwtfl.lt.  0)  write(8>1237)  wtco 
ifdwtfl.ee.  0)  writeO.  1253) 
ifdwtfl.it.  0)  write<8»1239) 
WRITE(8» till) 


ipira  »1 
return 


190  continue 

if ( .not.checM)  return 
RAO  *  SORT ( SL£N*SWID/>i ) 

WRITE (8. 1300)  ESS » RAD 
WRITE(8» 1320)  SLEN.SWID 
aster  *  ess/outl**2 
WRITE (8» 1340)  QUTCciOUTSZ.astar 
write<8fl350)  swcl»swal»senl>srhl 
WRITEO.  1360)  QUTLfflUTB 
C 
C 
C 

1300  FORMATdHO.'Saurce  strength  Cki/sl  ’.  S18X.1PG13.3.T60. 

t'Eauivalent  Priaary  source  radius  Cal  .*  '.1PG13.3) 

1320  FORNATdH  » 'Eaui valent  Priaary  source  length  Cal  '  '»4X» 

41PG13.5.T60. 'Eouivalent  Priaary  source  width  Cal  !  S1X.1PG13.5) 
1340  F0RHAT(/» '  Secondare  source  concentration  Ckg/a**31  !  '» 
I1PG13.5.T60. 'Secondare  source  SZ  Cal  1  ' .13X. IPG13.3.//. 

1  '  Contaainant  flux  rate!  '»lrsl3.3»/> 

1330  foraat</»'  Secondare  source  aass  fractions...  contaainant!  '» 

1  IrslS.AtZxi'  air?  ',lril3.5»/» '  '»10x»'  Enthalpy!  '» 

1  lrsl3.3»5x»'  Density!  ' »lrsl3.5) 

1360  FORMAT (1H  » 'Secondary  source  length  Cel  !  '»13X»1PG13.3»T60» 

*' Secondary  source  half-width  Cal  !  ' »3X.1PG13.3) 

C 

C 

RETURN 

END 
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C  INPUT  SUBROUTINE  FOR  DEGADIS  NOBEL 
C 

SUBROUTINE  10  ( tend  *  gaassO  >  OPNRUP ) 

Illicit  Real*8  (  A-H*  0-Z  )»  Integer*4  (  I-N  ) 
c 

include  'sxsldegadisJDEGADISl.dec' 

BLOCK  COMMON 

COMMON 
«/TITL/TITLE 

S/GEN1/  £T<2*igen)*RlT<2»igen) 

I/GEN2/  DEN<5# igen) 
t/ITI/  T1 * TINP*  TSRC*  TOBS*  TSRT 

l/PARM/  UO*ZO*ZR*ML*USTAR»K*G* RHOE i RHOA .DELTA* BETA  *  GAMMAF * CcLOU 
t /co*_gp  top/  sas_au*sas_te*p * gas. rhoa * gas.cpk  *  gas.cpr  * 

*  gas_ufl*gas_lfl*3as_zsp*g3s_naee 

S/coaata/  i stab  * taab  >  p aab * huaid  * i sof 1 *  tsurf  * ihtf 1  *  htco » i utf 1 » wteo 
»/coe_ss/  ess  *  si an » suid i outcc  * outsz * outb  *  out! 

*/phl ag/checkl * check2  * again » check  3  * check  4  *  chackS 
«/coa.sigx/  sigx_coeff  *sigx_pow*sigxjin_dist»sigx_flag 
*/NEND/POUNDN. POUND 
C 

c 

charaeter*80  TITLE(4) 
character*4  pound 
eharacter*24  TSRC.  TINP.  TOBS.  TSRT 
character*!  gas.naae 
C 

REAL*8  ML*K 

logical  check 1  *  checks .again* check3 *  check4 * check5 
C 

character*40  OPNRUP 
C 

GPEN(UNIT*9*  NAME*OPNRUP *  TYPE3' OLD' ) 

C 

DO  90  1*1*4 
READ(9*2000)  TITLE(I) 

90  CONTINUE 
2000  FORMAT (A80) 

C 

READ<9.*)  UO.ZO.zr 

read(9it)  istab 

READ<9.*>  DELTA. BETA.al 

read ( 9  *  * )  s isx.coef f *  sigx.pow *  si sx.ain.di st 

read(9*f)  taeb.paab.huaid 

read(9*X)  isofl*tsurf 

read<9**)  ihtfl.htco 
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pead(9»*)  iwtflrwtco 
pead(9»2020)  aas.naee 
2020  FORMAT (A3) 

r«ad<?’t)  das.sw t das.  tee? > aas. rhoe 
pead(9r*)  da*_c*k>aas_cpi» 
p»ad(9»*)  das_ufl»das_lfl>sas_2s* 

C 

ifdsofl  .eo.  0)  than 

phoe  ■  aas. rhoe  t  »a mb 

rhoa  ■  psabtd»+huaid)/( .00283+  0.00454*hueid)/taeb 

aoto  103 

endif 

R£AD(?r*)  HP 
DO  100  IS1»NP 

100  READ<9»*>  D£N(1*I) »DEN(2>I) »den(3>I)>den(4ri)rden<3»i) 

RH0E  *  DEN(3»NP) 

RHOA  a  DEN(3»1) 
den(l»ne+l)  »  2. 

C 

103  READ<9>«)  CcLOU 
C 

r»ad(9>*)  aeassO 
READ(9f«)  HP 
DO  110  1*1 ,NP 

110  READ(9f t)  ET<1,I)»ET(2»I)»R1T(2»I) 

TEND  *  ET(l»NP-2) 

I  *  NP  +  1 
ET ( 1 » I )  *  POUNDN 

ET(2»I>  »  POUNDN 

RlT(lrl)  *  POUNDN 
R1T(2»I)  »  POUNDN 
C 

DO  120  l3i,NP 
120  R1T<1»I)  *  ET(lrZ) 

C 

read ( 9  >  *  >  check 1 t cheek2 » adain»  check3 » check 4 » checks 
c 

tobs  *  '  ' 
tsrt  »  '  ' 

READ(9>2010)  TINP 
2010  foreat(a24) 

C 

if(check4)  read(9>*)  ess »slen>s«id 

c 

CL0SE(UNIT*9) 

RETURN 

END 

#*#« 


■iwnwiui'mwn 


1  1  F  '  If  d  Vm  I1,'  l^v  W  r*  W* 


»- 1 


SUBROUTINE  IQT(OPNRUP) 

Iaelicit  Re3lt8  (  A-H,  0-Z  >,  Inte3er*4  (  I-N  ) 


C 

incl ude  ' systdesadis i BEGAD I SI N . dec ' 
c 

COMMON 

l/TITL/  TITLE 

$/GENl/  £T!2»i3en),RlT!2»iSen) 

>/GEN2/  DEN<5,iSen) 
f/ITI/  T1 » TINP , TSRC ,  TOBS » TSRT 

* /P ARM/  UO  »  ZO , ZR  ,  ML , USTAR , K » G , RHOE » RHOA  , DELTA , BETA » GAMMAF , CcLOU 
1/coa.Br pop/  B3s.au  » aas.tenp »  335. rhoe , sas.cpk  » eas.cpp 
$  33S_uf 1 »  335.1 f 1 , 33S-ZSP » 33S_naae 
1/ cob— ss/  ess » s 1 en , sui d , outcc » out sz , outb  *  out 1 
f/FHLAG/  CNECX1 >  CH£CK2t AGAIN; CHECK3,CHECK4»CHECX5 
t/coa.sisx/  siSx.coeff ,si3x_pou,sisx_ain_dist,sisx_flas 
*/NEND/  POUNBN, POUND 
C 

charaeter*80  TITLE (4) 
chsr3ctert3  3as_naae 
char3cter*4  pound 
character^  TSRC,  TINP , TGBS, TSRT 
C 

REAL*8  HL,K 

LOGICAL  CHECK1 .CHECK2 .AGAIN, CHECK3 , CHECK4 , CHECKS 
C 

character*!*)  OPNRUP 
char3Ctert40  STRING 
character^  duaau 
C 

WRITE!A» 1100) 

URITE! A.lllO) 

C 

Cm  OPEN  THE  INPUT  FILE 
C 

OPEN ! UN I T=8 » NANE=OPNRUP , TYPE* ' NEW ' , 

*  csrriaaecontrol^'list' »r#cordtype»'v3ri3ble' ) 

C 

C*M  NOW  GET  THE  TITLE  BLOCK 
C 

WRITE(A» 1120) 

WRITE (A, 1130) 

r 

w 

DO  100  1=1,4 
READ(3,1134)  TITLE! I) 
duaay  =  titled) 

IF(duaau<i:4)  ,EQ.  POUND(IU))  GO  TO  110 
WRITE<8,1135)  TITLE! I) 

100  CONTINUE 
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GO  TO  130 
C 

110  CONTINUE  !  FILL  OUT  THE  BLOCK 

II  *  I 

00  120  I  >  11*4 
TITLE(I)  «  '  ' 

WRITE(8*1133)  TITLE(I) 

120  CONTINUE 
130  CONTINUE 
C 

cm  Ataoseheric  parameters) 
c 

URITE<6»1140) 

URITE(6*U42) 

READ<5**>  UOtZOrZR 
URITEO* 1020)  UO>ZOfZR 
C 

c*«  stability 
c 

URITE(6* 1130) 

READ(5*1310)  NCHARf STRING 

istab  *  4  !  default  is  D  stability 

IF<STRING.ea. 'A'  .or.  string. eo. 'a' )  istab*l 
IF<STRIN6.eo.'B'  .or.  string.ee. 'b' )  istab»2 
IF<STRING.ee.'C'  .or.  string. eo.'c')  istab«3 
IF(STRING.#a. '0'  .or.  string.ee. 'd' )  istab«4 
IF<STRING.ee.'E'  .or.  string.ee. 'e' )  istab*5 
IF(STRING.oo.'F'  .or.  string. to. 'f' )  istab*6 
goto< 161 f 162* 163* 164*165* 166)  istab 
161  delta  *  0.3  !  A 

beta  »  0.? 

■1  a  -11.43  *  zr **0.103 
sisx.coeff  *  0.02 
sidx-pow  a  i,22 


sigx.ain.dist  =  130. 
goto  170 

162  delta  a  0.33  !  B 

beta  3  o.? 

el  =  -23.98  *  zr**0.171 
sidx.coeff  *  0.02 
sisx.row  a  1,22 
sigx.ain.dist  3  130, 
goto  170 

163  delta  3  0.20  !  C 


!  used  for  infinite 


beta  *  0.9 

•1  >  0.0 

sidx_coeff  *  0.04 
sidx_*ow  *  1.14 
sidx_ain.dist  *  100. 
doto  170 

165  delta  »  0.1  !  E 

bets  *  0.9 

•1  a  123.4  t  zr 00.304 
sidx-eoeff  *  0.17 
sidx_Mju  a  0.97 
sidx_ain_dist  =  SO. 
doto  170 

166  delta  a  0.044  !  F 

beta  »  o.9 

*1  »  25.98  $  zrttO. 171 
sidx.coeff  *  0.17 
sidx.pow  a  0.97 
sidx.ain.dist  a  50, 
c 

170  HRITE(8.1040)  istab 
C 

172  URITE(6. 1160)  delta.beta.al »sidx_coeff >sidx_pow,sidx_ain_dist 
read(5»1310)  ncharrstrind 
if(strind.ee.'d'  .or.  strind.eo. 'D' )  then 
«rite<6»1600) 
read(5»d)  delta 
doto  172 

else  if (strind.ee. 'b'  .or.  strine.ee. 'B' )  then 
urite(4. 1620) 
read(5.t)  beta 
doto  172 

else  if (strind.eo. '1 '  .or.  strind.ea. 'L' )  then 
urite(6,1660) 
read(S.t)  el 
doto  172 

else  if (strind.eo. 'c'  .or.  strind.ea. 'C' )  then 
write(6,1670) 
read(S.f)  sidx-coeff 
doto  172 

else  if (strind.eo. >'  .or.  strind.ea. 'P' )  then 
write(6f 1680) 
read(Sf*)  sidx_^ou 
doto  172 

else  if (strind.eo. 'a'  .or.  strind.eo. 'H')  then 
write(6,1690) 
read(3»*)  sidx.ain.dist 
doto  172 

else  if (nchar.eo.O  .or.  strind.eo. 'n'  .or.  strind.ea. 'N' )  then 
WRITE (8, 1020)  DELTA. BETA, el 
WRITE<8, 1020)  sidx.coeff ,sidx.eow»sidx.ain_dist 

3  —  sssIdedadisJIOT.EOR 


v:*f 

Svj 


■  ,-.ii 

'M 

w 

:v;^ 

’  yi 


<*2i< 

iSs 


If 

l;k 

I  % 

»,'  i j 


m 

f 

In?! 


«ri 

m 


C-58 


else 

so to  172 
endif 

ambient  pressure*  temperatures*  and  huaidit* 

urite<&»1500) 

read<3*«)  taabipaab 

tsab  *  taab  +  273.13  !  K 

vaporp  ■  6.02?8e-3*  exr<3407.S  (1./273.13-  1,/taab))  !  ata 
sat  «  0.622tvaporp  /  (paab-  vaporp) 
write<6»1580) 
read(3*1310)  nchar*strins 
if (strins.eo. .or.  strins.eo. 'A' )  then 
write(6* 1585) 
read(3*t)  huaid 
relhuaid  •  lOO.thuaid/sat 
urite(6*158d)  relhuaid 
soto  200 
endif 
write<6*1587) 
read(5*t)  relhuaid 
huaid  a  relhuaid/100.  t  sat 
)  rhoa  3  paab«(l.+huaid)/( .00283+. 00456*huaid)/taab 
write<6* 1388)  rhoa 
write<8*1023)  taab*paab*huaid 

isofl  *  0 
ihtfl  *  o 
htco  *  0. 
iwtfl  *  0 
wtco  a  0. 

write<6*2000) 
read(5*1310)  nchar*strins 
i f (strins.eo. 'Y'  .or.  strins.eo. 's' )  then 
isofl  *  i 
tsurf  >  taab 
Soto  230 
endif 


urite<6*2020) 
read<5il310)  nchar»strins 
if (strins.eo. 'Y'  .or.  strins.eo. 's' )  then 
write<4*2030) 
read(3*t)  tsurf 
220  write<6*2040) 

read(3*1310)  nchar*strins 

if (strins.eo. 'V'  .or.  strins.eo. 'v')  then 
ihtfl  ■  -1  !  constant  value 

write<6»2030> 
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read<5»*)  htco 

els#  if(strind«eo.  'C'  .or.  strina.eo. 'c'  .or.  nchar.ea.O)  then 

ihtfl  »  1  !  lacsl  correlation 

else  iflstrina.eo.'L'  .or.  strina.eo. '1')  then 
ihtfl  •  2  !  LLNL  correlation 

htco  ■  0.0123  !  C»3a/s 

urite<6»2043)  htco 
read(5»1310)  nchar>strind 
if(strina.eo*'Y'  .or.  strina.eo. '*') 

1  resd<5»*)  htco 

else 
Soto  220 
endif 

else 

doto  230 
endif 
c 

urite<6»2100) 
read<3*1310)  nchar.strind 
if (strina.eo. 'Y'  .or.  strina.eo.'s')  then 
iutfl  *  1 
write(6>2043) 
read<3»1310)  nchar.strind 

if(strind.eo.'V'  .or.  strina.eo.'v')  then 

iutfl  *  -1 

urite<6»2120> 

read(Sft)  utco 

endif 

endif 

c 

250  continue 

urite(8»1060)  isoflitsurf 
urit#(3»!060)  ihtfl rhtco 
write<8*1060)  iutflrutco 
c 
C 

c*t»  sas  characteristics 


urite<6>1310) 
re*d(3» 1415)  Sas.naae 
write<8>1415)  sas.naae 
sas.au  «  16.04 
das. tee?  *  111.7 

das.rhoe  *  1.7?2ti»#ab  !  correct  to  rand 

Sas.c?k  *  2730. 

Jas.cr?  «  1.00 
das.gfl*  0.15 
das_lfl»  0.03 
das.zsr*  0.5 

i f (sas.naae. eo. 'LNB'  .or.  aas.naae.eo. 'lnd' )  then 
aas.au  *  16.04 
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SSS-tee?  »  111.7 

ias_rhoe  »  i.792Veaeb  !  correct  to  raeb 

ias_crk  a  3.4e-8 

4M.W  a  3,00 

aas_ufl«  0.13 

ies_lfl»  0.03 

*««-2Spa  0.3 

endif 

if<ias_neee.ee.'lP0'  .or.  MjmmiIQ.'Ih')  then 
injw  a  44.09 
sln.tftf  a  231. 

4ai. rhoe  *  2.400traeb  !  correct  to  ra*b 

ias.crk  a  13,4 

4»*-W  a  2.23 

ees-ufla  0.10 

aas_lfl*  o.02 

eas-zspa  o.S 

endif 

270  urite<6»1320)  ias_ew* ias_tt«»  > ias_ rhoe»  aas_erk » ias_ci»r  > 

1  aas_uflfias_lfl»aas_2sr 

readf 5.1310)  nchar.strini 

iffstrini.ee.'e'  .or.  strxni.ee. 'M')  then 
urlte(6fl330) 
readfS.t)  aas.nw 
do  to  270 

else  iffstrini.ee. 't'  .or.  strini.ee. 'T' )  then 
urite(4»1330> 
read(Sii)  ias-teer 
ioto  270 

else  iffstrini.ee. 'd'  .or.  strini.ee. 'D')  then 
urite(6»l333) 
read(3» *>  ias.rhoe 
ioto  270 

else  if (strini.ee. 'h'  .or.  strine.ee. 'H')  then 
urite(6f 1570) 
read(3»*)  aas.crk 
ioto  270 

else  iffstrine.ee. >'  .or.  strini.ee. 'P')  then 
writefA. 1571) 
readfSft)  ias-cer 
ioto  270 

else  if (strini.ee. 'u'  .or.  strini.ee. 'U' )  then 
write(&»1572) 
rtad(3»<)  ias.ufl 
ioto  270 

else  iffstrini.ee. '1'  .or.  strini.ee. 'I')  then 
uritefOf 1373) 
read(5»X)  ias.lfl 
ioto  270 

else  iffstrini.ee. '2'  .or.  strini.ee. 'V  )  then 
urite<6»1374) 
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I 


a 


! 


read(3»*)  sas-zsr 
Soto  270 

else  iffnchar.eo.  0  .op.  strins.ee. 'n'  .or.  striM.ee. 'N')  thtn 
HRITE(8rl020)  sas-toer? sas_rhoe 

urite<8»1020)  Sas_erk»sas_crr 
HRITE(8f1020)  sas_ufl»sas_lfl»sas-zsp 

•1st 

Soto  270 

endif 


1 


\4 


c  density  curve  if  isothereal 
c 

if(isofl  .eo.  0)  Soto  460 

URITE(6»1161) 

WRITE(6»1162) 

URITE(6»1163) 

WRITE<6»1164>  rhoa 

URITE(6* 1163) 

URITE<6f1166) 

Soto  320 
C 

230  urite<6»1290) 


320  LUNIN  a  5 

«RITE<6»1300) 

READ(3» 1310)  NCHARi STRING 
IF(STRING.EQ. 'y'  .or.  striM.ee. 'Y' )  60  TO  360 
GO  TO  400 
360  WRITE(6»1320) 

REA0(3f 1310)  NCHAR i STRING 
OPEN ( UNIT*10 » NAHE-STRING » TYPE* ' OLD '» err-280 ) 
LUNIN  *  10 
400  CONTINUE 

IF (LUNIN  .EQ.  3)  URITE(6»1170)  isen 

REAO(LUNIN>«)  NP 

MRITE(8» 1040)  NP 

IF(LUNIN  .EQ.  5)  MRITE(6f1180) 


DO  440  1*1  »NP 

den<4>i)  *  0.  !  0.0  by  default  for  isothere 

den(Sti)  *  taeto  !  taeb  for  isothere 

READ(LUNIN»*>  DEN(1»I) »DEN<2» I) »DEN(3. I ) 
if ( i  .ea.l  .and. 

1  <den(3>l)/rhoa.St. 1.005  .or.  rhoa/den(3>l).st.l.005>)  then 

den(3rl)  *  rhoa 
write<6»1340)  rhoa 
endif 

if(i.#o.np)  THEN 

IF(  den(2»i)/Sas_rho#  .St.  1.003 
1  .or.  sas_rhoe/den(2»i>  .St.  1.003 

1  .or.  den(3ri)/Sas_rhoe  .at.  1.003 

sy sSdesadi s  J IOT . FOR 
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•mv  .W»Pi**S*.Sl 


1 


.or.  3as_ rhce/den ( 3  >  i )  .St.  1.009)  then 

den(2> i )  *  Sas.rhoe 
den(3»i)  *  3as_rhoe 
write<6»1341)  sas.rhoe 
endif 
and  if 

1WITE(3»1023)  DEN(l>I)>DEN(2»I)fDEN(3»I) »Den<4»I)»den(9»i) 
440  CONTINUE 

IF  (LUNIN  .EQ.  10)  a0SE(UNI>10) 

C 

e 

460  WRITE(6*1280) 

READ<5»*>  CcLOW 

if (cclow  .1*.  0.)  cclow*0.009  !  don't  lat  0.  dot  throush 

WRITE (8. 1010)  CcLOW 


cllt  source  description 
c 

write(6*l440) 
re3d(5»*>  seassO 
write<8»1020>  seassO 
c 
c 

check 4  *  .false. 
urite<6»1400) 
redd (3. 1410)  dune* 

if(duee*.eo.'s'  .or.  dunes. eo. 'Y')  Soto  480 
Soto  920 
480  continue 

urite<6»1420) 
read(9>t)  ess 
write(6»l430> 
read(5>t)  rlss 
nr  *  4 
c 

tend  *  6023.  !  C*3  sec 
c 

at<l>l)  ■  0. 
et(2»l)  *  ess 
rlt(2»l)»  rlss 
#t(l»2)  *  tend 
et(2»2)  »  ess 
rlt(2>2)»  rlss 
et(l»3)  *  tend  +  1. 
et<2»3)  ■  0. 
rlt(2»3)»  0. 
et(l»4)  ■  tend  +  2. 
at(2>4)  a  o. 

rlt(2i4)a  0. 

slen  *  sart(ri*rlss**2> 
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suid  *  slen 

check 4  *  .true.  •  steady  state  run 

Soto  760 
c 

S20  continue 
C 

WRITER  1190) 

WRITE(6»1200) 

WRITE (6? 1210) 

WRITE(6? 1220) 

WRITE (6, 1163) 

WRITE(6?1230) 

WRITE(6?1240) 

WRITE(6»1250) 

Soto  600 
C 

560  urite<6?1290) 

C 

600  LUNIN  >  3 

WRITE! 6? 1330) 

READ(5?1310>  NCHAR? STRING 

IF (STRING.ee. 'Y'  .or.  strins.eo. )  soto  640 

Soto  680 

640  WRITE(6fl320) 

READ<3?1310)  NCHAR, STRING 

OPEN ( UNIT* 10  ? NAHE*STR ING » TYPE* ' OLD ' ?  er  r«560 ) 

LUNIN  *  10 
680  CONTINUE 

IF (LUNIN  .EQ.  3)  WRITE(6# 1260)  isen 

READ(LUNIN»S)  NP 

IF (LUNIN  .EQ.  3)  WRITE(6» 1270) 

C 

DO  720  1*1 ?NP 

READ ( LUNIN? S)  ET(1?I) ?ET(2?I) ?R1T(2»I) 

720  CONTINUE 

IF (LUNIN  .EQ.  10)  CLOSE(UNIT*10) 

C 

760  continue 

WRITE! 8? 1040)  NP 
DO  800  1*1 ?NP 

800  WRITE(8? 1030)  ET!1?I) ?ET(2?I) ?R1T(2?I) 

C 

if(et(2>l).ee.O.  .and.  seassO.ne.O. )  check2*. true.  !  HSE  tuee  seill 
ur i te ( 8 ? t )  check 1 ? check2  ? asa in ? check3 ?  check4  ? check5 
C 

istat  *  libSdate.tiae(tine) 

WRITE! 8? 1050)  TINP 
c 

if(check4)  urite(8?1020)  ess?slen?swid  !  steads  state 


9  —  sssfdesadisdOT.FOR 


CUJSE<UNIT*8) 


1010  foraat(lx*lPSl4«7) 

1020  foraat(3<lx*lPSl4.7)) 

1025  foraat<5Ux*lPSl4.7>) 

1030  foreat<lx*2(lPSl4.7*lx)*lPSl4.7> 

1040  forMt<lx»i4) 

1050  faraat<a24) 

1060  foraat(lx»i4*lx*lrSl4.7) 

1100  FORMAT ( 5X » ' INPUT  MODULE  DEGAD IS  MODEL') 

1120  F0RMAT(5X* 'Enter  Title  Block  —  up  to  4  linos  of  80'* 

I'  characters') 

1130  F0RMAT(5X> 'To  stop*  type  *//•') 

1134  FORMAT <A80) 

1135  FORMAT (A80) 

1140  FORMAT ( 5X » ' ENTER  MIND  PARAMETERS  —  UO  (m/%),  ZO  (m),  '* 

I 'and  ZR(o) ' ) 

1142  foraat(5x* 'UO  —  Mind  velocity  at  roforonco  heisht  Z0'» 
$/*5X*'ZR  —  Surface  RouShnoss' ) 

1150  FORMAT (/*5X» 'Enter  the  Pasouill  stability  class!  (A*B*C*'* 
$'B»E»F)  <B>  '»«) 

1160  format!/*'  The  values  for  the  ataospheric  parameters' , 

$'  are  set  as  follows!'* 

«/»'  DELTA!  ' *F12.4» 

«/.'  BETA!  ' *F12.4* 

t/,'  Monin**Obufchov  lensth!  '*F12..4»'  o'* 

•/*'  Sisaa  X  Coefficient!  '*F12»4* 

*/»'  Sisea  X  Power!  '*F12*4» 

«/*'  Sisaa  X  Miniaua  Distance!  '*F12.4»'  a'» 

•/*'  Do  you  wish  to  chanse  anw  of  these?'* 

•/*'  <No*Delta*Beta*Lensth*Coefficient*Power*Miniaua)  <N>  '**) 

1161  FORMAT! /*3X* 'The  density  is  deterained  as  a  function  of  con'* 
S'centration' ) 

1162  F0RMAT(5X*'bv  a  listins  of  ordered  pairs  supplied  by  the  user') 

1163  FORMAT (5X* 'Use  the  followins  fore!') 

1164  F0RMAT(/*3X*5X*' first  POint'*6X»'-—  Pure  air  y»0.0*Cc»0»*'* 

1  'RHOO*RHOA  ' * 1PS13.5) 

1165  F0RMAT<3<15X* '.'*/)) 

1166  FORMAT ( 3X • 5X  * ' 1 ast  point' *7x* '—  pure  sas  y»1.0*Cc»RH0E* ' * 

1  'RH0G*RH0E'> 

1170  F0RMAT(/*5X* 'ENTER  THE  NUMBER  Iff  DATA  TRIPLES  <aax«' *i2» ' ) ' * 

%•  FOR  THE  DENSITY  FUNCTION!  '*•> 

1130  F0RMAT(/*3X* 'Enter  Mole  frac*  Cc  <ks/e«3>*  then  RHOG  '* 

1  '(ks/a»3)  by  triples') 


1190  F0RMAT(/*5X*10X* 'Source  Description') 

1200  F0RMAT(1X*/*5X» 'The  saae  fore  used  by  the  density  description') 
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1210  F0RMAT(5X* 'i*  used  by  the  source  description  as  follows') 

1220  F0RMAT(/*5X*3X*'first  eoint'»6X* '—  tiae«0  E*R1  at  initial  '» 
•'(nonzero)  values') 

1230  FORMAT ( 3X* 5X » ' nxt  to  last  point  —  ties* TEND  E*R1*0.') 

1240  FORMAT (5X*5X* 'last  point' *6X* 'tiae«TEND+  E*R1^0.') 

1230  FQRMAT(/*5X* 'Note*  the  final  tiee  is  the  last  tiae  entered  '* 
•'where  E  and  R1  are  non-zero') 

1260  F0RMAT(/*3X# 'ENTER  THE  NUMBER  OF  TRIPLES  (eax-  '*i2»')  FOR  '» 

•'THE  SOURCE  DESCRIPTION:  '*«) 

1270  FORMAT (/fSX* 'Enter  TIME  (sec)*  EVOLUTION  RATE  (ks/a«3),  '» 

•'and  POOL  RADIUS  (a)') 

1280  F0RMAT(3X* 'Enter  the  LOWEST  CONCENTRATION  OF  INTEREST  (k*/'» 
t'a*S3)  :  '»«) 

1290  f oraat(/»'  This  file  was  not  found.') 

1300  FORMAT (/ * '  Do  sou  have  an  input  file  for  the  Density  '* 

•‘function?  Cy  or  N3  '*•) 

1310  FORMAT (Q*A20) 

1320  FORMAT ( '  Enter  the  file  naae:  CDIR3FILE-NAME.EXT  ',*) 

1330  FORMAT < '  Do  sou  have  an  input  file  for  the  Source  '* 

•'Description?  Cy  or  N3  '*•) 

1340  foraat(/*'  Air  density  corrected  to  '*1ps13.5'  ks/a «3'*/) 

1341  foraat(/*'  Contaainant  density  corrected  to  '*1pS13.5'  ka/a*S3'*/) 
c 

c 

1400  foraat(//»'  Is  this  a  Steady  state  siaulation?  <y  or  N>  '*») 

1410  foraat(a4) 

1413  faraat(a3) 

1420  foraat(/ * '  Enter  the  desired  evolution  rate  C*l  ks/sec  :  '»•) 

1430  foraat('  Enter  the  desired  source  radius  C*3  a  «  '»•) 

1440  foraat(/»'  Specification  of  source  rate  and  extent. '* 

•///*'  Enter  the  initial  aass  of  Pure  sas'* 

•'  over  the  source,  (k s)'*/*'  (Positive  or  zero):  '*») 


1500  foraat(/*'  Enter  the  aabient  teaperature(C)  and  pressure' * 

1  '(ata):  '*«) 

1510  foraat(/*'  Enter  the  code  naae  of  the  diffusing  species:  '*•) 

1320  fo raat(/*'  The  characteristics  for  the  Sas  are  set  as  follows:'*/; 
•'  Molecular  weisht:  '*f7,2*/* 

>'  Storase  teaperature  CK3:  '*1ps13.3*/* 

•'  Density  at  storase  teaperature*  PAMB  Cks/a**33t  '*1ps13.3»/» 

*'  Mean  Heat  capacity  constant  '*Ips13.5*/* 

•'  Mean  Heat  capacity  power  '*1ps13.5*/* 

>'  Upper  Flaaeability  Liait  Caole  fracl  ' *1ps13.3*/* 

•'  Lower  Flaaaability  Liait  Caole  frac3  '*1ps13.5*/» 

•'  Heisht  of  Flaaaability  Liait  Ca3  '*1ps13.5*/* 

•'  Do  you  wish  to  chanse  any  of  these?  '* 

•' (No*Mole*Teap*Den*Heat*Power*Upper*Lower*2) ' * 

*'  <N>  '*«) 

1330  foraat('  Enter  the  desired  Storase  Teaperature.*  '*•) 

1533  foraat('  Enter  the  desired  Density  at  Storase  '* 
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1  'Temperature  and '*'  aebient  pressure:  '*•> 

1550  foraate '  Enter  the  desired  Molecular  Weidht:  ' •%) 

1570  formate'  Enter  the  desired  Mean  Heat  Capacity  constant:  '*i> 

1571  foreatC'  Enter  the  desired  Mean  Heat  Capacity  power:  ' *<) 

1572  formate'  Enter  the  desired  Upper  Flammability  Limit:  '»<) 

1573  forsatC'  Enter  the  desired  Lower  Flammability  Lieit:  '*$) 

1574  formate'  Enter  the  desired  Heidht  for  the  flaaeable  lieit  calcula'* 

1  'tions:  '*!> 

1580  formate/*'  The  aebient  hueiditw  can  be  entered  as  Relative  '* 

1  'or  Absolute.'*/*'  Enter  either  R  or  A  <R  or  a>:  '*•> 

1585  foraat('  Enter  the  absolute  hueiditw  ekd  water /kd  BOA)*  '*•) 

153d  foreat('  This  is  a  relative  hueiditw  of  '*1pS13.5»'  2 ') 

1587  foraat('  Enter  the  relative  hueiditw  (Z>:  '  *1) 

1588  foraa te/*'  Aebient  Air  density  is  '*lpdl3.5»'  kd/e**3') 


1600  foraatC'  Enter  the  desired  DELTA:  '*<) 

1620  foreat('  Enter  the  desired  BETA:  'ft) 

1 660  formate'  Hotel  For  infinity*  ML  »  0.0'*/* 

t  '  Enter  the  desired  Mon in-Obukhov  lendth:  (a)  '*$) 

1670  foraat('  Enter  the  desired  Sidea  X  Coefficient:  '*!) 

1630  foraat('  Enter  the  desired  Sidea  X  Power:  '*t> 

16?0  foraatC'  Enter  the  desired  Sidea  X  Minieue  distance:  (a)  '*$) 
c 

2000  f create/* '  Is  this  an  Isothereal  spill?  <w  or  N>  '*t) 

2020  formate/*'  Is  heat  transfer  to  be  included  in  the'* 

1  '  calculations  <w  or  N>  '* t) 

2030  formate '  Enter  the  surface  temperature  C*3  K  :  '*$) 

2040  foraate'  Do  you  want  to  use  the  built  in  correlation*'* 

1  '  the  LLNL  correlation*  or'*/*'  enter'* 

1  '  a  particular  value?'*/* 

1  '  (Corr*LLNLcorr*Ualue)  <C>  '*•) 

2043  formate/*'  The  fore  of  the  correlation  is5'*/» 

1  6x*'Q  -  (Vh  %  rho  t  cp)  *  area  *  (tsurf-teep) ' *//* 

1  '  with  Vh  *  '*lPdl3.5* '  e/s.'*//* 

1  '  Do  you  wish  to  chande  the  value  of  Oh?  Cy  or  Hit  '*$) 

2045  foraatC'  Do  you  want  to  use  the  built  in  correlation  or  enter'* 

1  '  a  particular  value?'*/*'  <C  or  v>  '*$) 

2050  formate'  Enter  the  HT  coefficient  value  C*3  J/mtt2/s/K  J  '**) 

2100  formate/*'  Is  water  transfer  to  be  included  in  the'* 

1  '  source  <y  or  N>  '**) 

2120  foraatC'  Enter  the  WT  coefficient  value  C*3  kmol/ett2/s/ata  :  '*♦) 
C 
c 

RETURN 

END 
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SUBROUTINE  FOR  SOURCE  EVALUATION  WHEN  NO  GAS  BLANKET 
IS  PRESENT. 

SUBROUTINE  NOBL(timout) 

Illicit  RcsltG  (  A-H»  Q-Z  )»  Intedert4  (  I-N  ) 

C 

include  'sysSdeaadisJDEGADISl.dec' 

C 

COHMON 

S/GEN1/  ET(2»iten)»RlT(2iiden) 

S/ERROR/  STP IN » ERBNO • STPHX *  WTRG » WTte » WTaa » wtsc >  uteb t wt mb , utuh » XLI » 
4  XRI>EPS» ZLOUf STPINZ » ERBNOZ » STPNXZ » SRCOER,  s  rcss » s rccut » 
f  htcut  t ERNOBL > NOBLr t t erf de r » epsilon 

S/P ARM/  UO » ZO  >  ZR » ML  t UST AR  t K , G . RHOE  > RHOA  r  DELTA » BETA  >  GAMMAF  >CcLOU 
S/coaata/  ist3b»taeb»P3ebfhuaid» isofl»tsurf »ihtfl>htco»iwtfl»wtco 
S/PARHSC/  RN f 5ZM » EMAX #  RHAX i T SC 1 » ALEPH » TEND 

*/coa_ss/  ess » si en » swi d » outcc > outsz » outb » outl > swcl » sual » senl »srhl 
*/phl as/  check 1 1 check 2 > asa in  > check3 » check4 » checks 
S/ALP/  ALPHA »alrhal 
S/phicon/  iphifl»dellss 
C 

REAL <8  ML>K 
c 

LOGICAL  REV 

losicsl  check 1 » check2 » asa i n ? checkZ t check  4 » checks 
DATA  REV/. TRUE./ 

REALt8  L 
c 

data  h/0./»Ri/0./ 
data  delt-a in/0.5/ 

r 

DEL TAT  *  (TEND  -  TSC1 ) /FLOAT (NOBLPT) 
if(deltst  .It.  delt_ain)  then 

noblpt  *  int( (tend-tscl)/delt_ain)  +1 
deltat  «  (tend-tscl)/flost(noblPt) 
endif 
C 

TO  »  TSC1 

IF(DELTAT  .LT .  2.)  GO  TO  100 

C 

URITE< lunloS> 1100) 

URITE(lunlotft)  DELTAT 

1100  FORMAT (3X»' TIME  INCREMENT  USED  ON  LAST  PORTION  OF  SOURCE  CALC') 

C 

100  CONTINUE 
C 

C  ESTABLISH  LOOP  TO  FINISH  SOURCE 
1  —  sssSdeSadisJNOBL.FOR 


c 


DO  110  I  *  IfNOBLPT 


C 

TIME  *  TO  +  FLOAT <I)*DELTAT 
IF  (I  •£<]»  NOBLFT)  TIME  *  TEND 
L  *  SQRTPI*AF6EN(R1T»TIME» 'R1T-BL' ) 
erate  »  AF6EN <  ET  *  TIME » ' ET-BL ' ) 
flux  ■  EraTe/L/L 
e 

astar  *  rhce  t  k*ustar*3lrh3l*dell3y/(dellay-l.)/i»hih3t(rhoe»L) 
if(abs<flux/astar)  .at.  emobl)  than 
check3  *  .trua. 
tiaaout  *  tiaa 
return 
end  if 
C 

call  szf (fluxiLfSZ>cclay>wclay*rholay) 
cc  =  cclay*dellay 
c 

call  adiabat(0>wc»ua»yc»ya»cc> rho >wa » enthalpy » tear) 

c 

IF(£rate  .LT.  EMAX)  80  TO  220 
EMAX  *  Erate 

RM  a  AFGEN(R1T, TIME. 'R1T-8L') 

S2M  *  S2 
220  CONTINUE 

RLIST  »  AFGEN ( R1 T, TIME »' RlT-BL') 

RMAX  »  dMAXl(RMAX» RLIST) 
c 

URITE(9»2000)  TIME>RLIST>h»flux»SZ»yc>ya»rho»Ri»wc>u3»enthalry»teer 
c 

ifCi.eo.5  .and.  check* )  aoto  500  !  steady 

C 

110  CONTINUE 
RETURN 


500  continue  !  steady  state  coerletion 

outcc  »  cc 

SWCl  3  VIC 

sual  >  ua 
senl  a  enthalry 
srhl  »  rho 
outsz  «  sz 

outl  a  sartpi  I  rlist 
outb  a  outl/2 . 
return 

2000  for»at(lril6.?> ix»lpal6.9Kiout_sre-2>(lx»lral3.6) ) 
END 

**#* 
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C..... . . . 

c 

C  SUBROUTINES  OB  AND  OBOUT  ARE  USED  IN  THE  OBSERVER  INTEGRATIONS 
C  OVER  THE  SOURCE. 

C 

SUBROUTINE  0B(tiae* Y,D*PRMT) 

Illicit  Real*8  (  A-H*  O-Z-  )*  IntederM  (  I-N  ) 

C 

include  ' sysidedadis  : DEGADIS2 . dec ' 
e 

COMMON 

I/GEN3/  r add ( 2 * aaxi ) * est  r  <  2 » aaxi ) *  s  reden < 2  *  aaxi ) * s  rcuc  < 2  * max  1 ) * 

$  srcua(2*aaxl)*srcenth(2*aaxl> 

$/PARM/U0*Z0» ZR»  ML  > USTAR*K*G * RH0E>  RHOA* DELTA* BETA*  GAMMAF*  CcLOU 
l/coaata/  i stab • taab * psab * huaid  * i sof 1  * tsurf  * ihtf 1  * htco * iutf  1  * utco 
*/PARMSC/  RM * SZM , EMAX >  RMAX  >  TSC 1  *  ALEPH *  TEND 
t/ALP/ALFHA  *  alphal 
S/phicoa/  iphifl*dellay 
c 

REAL*8  K*ML 
laaical  flaa 
C 

DIMENSION  Y<1)*D<1)»PRMT<1) 

INTEGER  HWIDTH *  Mrate  *  C  rate  *  BDArate  *  Hrate 

DATA  HMIDTH/l/*Mrate/2/*Crate/3/*BDArate/4/*Hrate/3/ 

C 

cm  PASS  TO  IN  PRMT(A) 

C 

flaa  =  isofl.ee.  1  .or.  ihtfl.ee.  0 
c 

T01  *  PRMT(6) 

::up  =  prat  (7) 

XI  =  XIT(TIME*T01) 

RG  =  AFGEN ( RADG  *  TIME  * ' RADG ' ) 

RLEN  *  PRMT(13) 

C 

BIPR  *  0. 

IF( < ABS(XI)-RG)/RG  .GE.  0.01)  WRITE (lunlod* 1000)  XI*RG 
IF<ABS(XI)  .LT.  RO)  BIPR  *  sert(RG*RG  -  XIIXI) 

C 

UI  =  UIT(TIME*roi) 
c 

Q  *  AFGEN(QSTR*TIME* 'QSTR') 

wc  »  AFGEN <srcwc*tiae* 'srewe' ) 

wa  -  AFGENIsrcwajtiaej'srcwa') 

enth  =  AFGEN(srcenth*tiae* 'sreenth' ) 

c 

welay  *  Y<Crate)/Y(Mrate) 

ualau  s  Y(BDArate)/Y(Mrate) 

if( .not. flaa)  enthlay  *  Y(Hrate)/Y(Mrate) 

1  —  systdeaadisiOB.FOR 


( 


-V 

VLvW.  v\  O.  O  .■ 


'->V 

k.1  v*  • 


■  ’  VV  **•  *’*•' 

.  %  p-’T-l.A  nJi 


WYJV-V* 


call  tprop< 1 ruclayrwalayranthlayrycryar war taap? rholay >cp) 
cclay  *  wclaytrholay 

c 

prat<8)  3  cclay 
rr*t(?)  *  wclay 
prateiO)*  walav 
prate  ID®  enthlay 
prat( 12) 3  rholay 
c 

cc  3  cclayXdallay 
rho  3  da 1 lay* e  rhol ay- rhoa )  +  rhoa 
c 

szob  »  0,01 

3rd  3  Q*exi-xup)/cc/(uOtzO/alPhal) 
if(::i.St.  joip  .and.  ars.St.O.) 

1  szob  3  arswei./alphal)  *  zO 

c 

HEFF  *  GAMMAF/ ALPHA IX  SZOB 
RISTR*RIF(RH0»HEFF> 

PHI  3  PHIF(RISTR»0. ) 
ualay  3  dellay  *  KXUSTAR*  ALPHA1/PHI 
C 

DeHHIDTH)=  UI  t  BIPR  /  RLEH 

DeCrata)  3  D(HWIDTH)XRLEN  *  Q 

D(Hrate)  *  <Q/UC  f  rhoatu»la»)  t  D  (WIDTH)  *RL£N 

O(BDArata)*  HXwa/we  t  rhoaXwalay/U.Hiuaid) )  *  D(HMIDTH)*RLEN 

if (f las)  raturn 

O(Hrata)  *  Q  *  anth/we  *  D<HWIDTH)«Rl EH 

C 

1000  F0RHAT ( '  ?0B?  —  Valua  of  XI  '»1p613.4»'>  Valua  of  RG  '» 

I  1pG13.4) 

RETURN 

END 

c 

c 

SUBROUTINE  OBOUTe  X>  Y>  DERYr  IHLFr  NDIM»  PRMT) 

C 

Iaplieit  Raal*8  e  A-H»  0-Z  )»  Intasar*4  (  I-N  ) 

DIMENSION  Xei)»  Y(l) »  DERY<1),  PRMT e 1 ) 

C 

PRMTei4)  »  prat(8)  !  cclay 

PRMT(13)  *  prate?)  !  welay 

PRMT(16)  »  prate  10)  !  Malay 

PRMT < 17)  »  pi  ate  11)  !  anthlay 

PRMTeiS)  *  prate  12)  !  rholay 

RETURN 
END 
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FUNCTION  PSI 


C 

Cttt  AS  PER  COLENBRANDER  — 

C 

ZTt*  THIS  FUNCTION  HAS  BEEN  DERIVED  FROM  BUSINGER* J.A. 
cm  WORKSHOP  ON  HICRONETEOROLOGY >  CHAPTER  2 »  HAUGEN>D.A.  (ED.) 
Cm  AMERICAN  METEOROLOGICAL  SOCIETY. 

C 

FUNCTION  PSIF(Z>ML) 

Implicit  Re»l*8  <  A-H»  O-Z  )>  InteS»r<4  (  I-N  ) 

C 

i nc 1 ud»  ' sas  $dedad iaIDEGADISl .  d#c' 

c 

REALM  ML 
C 

IF(  ML  )  10» 20»30 
C 

10  A  3  (l.-13.*Z/NL)t*.23 

PSIF  =  2.*dL0G((l.+A)/2.)  +  dLQG((l.+A*A)/2.)  -  2.*daTAN(A)  + 
*  PI/2. 

RETURN 

C 

20  PSIF  =  0. 

RETURN 

C 

30  PSIF  »  -4.7tZ/NL 
RETURN 
END 


1  —  sasldtsadisSPSIF.FOR 


c 

C  SUBROUTINES  FOR  PSEUDO-STEADY  STATE  INTEGRATION. 

C 

SUBROUTINE  PSS(DIST*Y»DERY*PRMT) 

I  illicit  Real*8  (  A-H»  O-Z  )»  InteaerM  (  I-N  ) 

C 

include  '  systdeaadis J DESAD IS2 . dec/1 ist ' 
c 

paraaeter  (zero*l .D-10»  rcrit»2.D-3) 
c 

COMMON 

i /FARM/  UO  *  ZO  >  ZR  *  ML » USTAR  *K*6* RHOE » RHOA * DELTA* BETA  *  GAMMAF *  CcLOU 
l/coaata/  i stab *  taab * p*ab * Muaid * i sof 1  * tsurf * ihtf 1  » htco * iutf 1  * utco 
%/PL?/  ALPHA *alphal 
l/phieoa/  iphifl*dellaa 
*/sprd_eon/  ce*  delrhoain 
c 

REAL*8  K* ML 
C 

DIMENSION  Y( 1 ) > DERY ( 1 ) *PRMT ( 1 ) 

DATA  rhouh/1/ *  SY/2/ *  8EFF/3/ *dM/4/ 

INTEGER  rhouh*SY*BEFF»dh 

C 

cm  PRMT  I/O  SETUP 

Cm  l  value  in/out 

cm  —  -  - 

cm  &  e  in 

cm  ?  Cc  out 

cm  9  B  OUT 

cm  9  CON  DERY(BEFF)  IN 

Cm  10  CON  DERY(SZ)  IN 

cm  11  NREC(I*1>  OUT  —  STARTS  OUTPUT  COUNTER 

cm  12  DIST  OUT 

cm  13 

cm  i4  *c  out 

cm  15  rho  out 

cm  16  teap  out  -  if  recorded 

cm  17  eaaaa  out  -  if  recorded 

cm  is 

cm  l? 

cm  20 

cm  21  $: 

cm  22  3C 

c 

Er3te  *  PRMT (6) 

B  *  Y(BEFF)  -  S0rtPI/2.*Y(SY> 

c 


s*slde*adi*:PSS.FOR 
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I 


>* 

v 

V 

s< 

V 


i 


rl 


i 

is 

V 


V 

t 


I 


% 


I 


’5 

V 

V 


a 


c  usins  the  lest  value  for  Sz 
c 

szO  3  *rat<22) 
sz  3  szO 
C 

Cm  MATERIAL  BALANCE 
C 

iii  *  0 

100  Cc  3  E rateXALPHAl/2 .  /UOX ( ZO/SZ ) XXALPHA/SZ/Y  <  BEFF ) 
cell  edi obit ( 0 » wc ? we » vc » y  a r cc > r ho » ua f en th » teae ) 
eclav  ■  cc/dellay 

call  adiabat<0*wc>wa»yclayiya»ccl3y»rhol3yfMal»enth»tealay)  !  for 
call  addheat(cclay»y<dh) »rholay»tealay»ca) 
p rod  3  daaxl<  Y(rbouh)/rholay/>rat(18)>  zero) 
sz  3  (  prod  )XX(l./slHial)  X  zO 
dif  3  absCsz  -  szO)/(abs<sz)+abs<szO)+zero) 
if(dif  .St.  rcrit)  then 
szO  3  sz 


szo  3  sz 
iii»iii+l 

if (iii  .St.  20)  call  trae<32) 


Soto  100 
endif 

f*rat<20)  *  rholau 

prat(21 )  3  sz 

HEFF  =  GAMMAF/ ALPHA 1 XSZ 


rit  3  0. 
temp  3  tealau 

if (lsofl.ea.0  .or.  ihtfl.ne.0)  then 

rho  >  de 1 1 ay X ( rho 1 ay- rhaa )  +  rhoa  !  estimate 

temp  3  (ua/rho)X(rholayXtealay/ual)  !  estimate 
rit  3  r if t< tea* >heff ) 
endif 

RISTR  3  RIF(RHQ»HEFF) 

PHI  3  PHIF(RISTR»rit) 


CALCULATE  DERIVATIVES 


DERY  <  BEFF )  3  0. 
del rho  3  rho- rhoa 

IFvdelrho  .ST.  delrhoein)  DERY(BEFF)  3  PRMT(?)Xsart(delrho/rhoa) 
*  X(SZ/Z0)XX< .3  -  ALPHA) 


DERY(SY)  3  4 . X8ET A/PI/Y < SY ) tY ( BEFF ) XX2  X 
f  (DELTAXSQPI02/Y(BEFF))  XX  (l./BETA) 


heish  3  hefftdellay 

C3 1 1  surface* tealau»heiShi  rholay»wal»c*»uatrte>arte) 
if(te»*.se.  t-.urf  .or.  tealau.se.  taab)  arte  3  0. 
rhouhb  3  rholayX  *rat(13)  X  <sz/zO>XXalrhal  X  Y(beff) 


2  —  sxsIdesadisIPSS.FOR 


msms 

Si 
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d-rhouhb  *  pratt 19)#»<b#ff )/phi 

dERY(dh)  *  ( a rt«IY ( baf  f ) /dal 1 aw  -  Y(dh)*d_rhouhb)/rhouhb 
dERY(rhouh)  *  <d_rhouhb-Y< Phouh)*DERY(baff) )/Y(b*ff ) 

C 

C««  RETURNED  VALUES 
C 

PRMT<?)  *  Cc 
PRNT(3)  *  B 
r>rat(14)»  «c 
prat<15)*  rho 
?rat(16)*  t»ap 

pratd?)*  <rhol3s-Phoa)/celas  !  aaaaa 

c 

RETURN 

END 

#441 
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c 

C  SUBROUTINE  PSSOUT 
C 

SUBROUTINE  PSSOUT (X.YiD.IHLF.NDIM. PRNT ) 

Ia^licit  Raal*8  (  A-H.  O-Z  )»  IntMtrM  (  I-N  ) 

C 

includt  ' sa**d#sadis : DEGADIS2 . d«c ' 

c 

paraattar  (nMJ*9i  z#ro=l  .9-10) 

c 

COMMON 

t /P ARM/UO » ZO > ZR » ML  >  UST AR » K » 6  »  RHOE » RHOA .DELTA. BETA . GAMMAF . CcLQU 
l/coaata/  istab.taab.aaab.huaid.isafl.tsurf .ihtfl.Mtco.iutfl.utco 
I /STP/STPO » STPP . ODLP >  ODLLP . STPQ » ODLG . ODLLG 
l/PHL AG/CHECK 1 . CHECK2 . AGAIN .CHECK3 . CHECK4 . CHECKS 
l/STOPIT/TSTOP 
c 

REAL *8  K.ML 

LOGICAL  CHECK 1 . CHECK2 .AGAIN. CHECKS » CHECK4 . CHECKS 
DIMENSION  Y  d ) » DU  > » PRMT < 1 ) .BKSP(nass) .OUT(npss) . CURNT <  ni»ss ) 

C 


cw* 

c 

C*W 
r  •#*#» 

OUTPUT  PARAMETERS 

FROM  PSS 

OUTPUT  TO  MODEL 

w  ♦ 

CW* 

X 

DIST 

cm 

PRMT(7) 

Cc 

cw* 

Y(l) 

SZ 

c*w 

Y(2) 

SY 

cm 

PRMT(8) 

B 

cw* 

PRMT(13) 

TO(I) 

clW 

prat(14) 

VC 

cw* 

prnt(lS) 

rho 

cW* 

j»rat(16) 

tern? 

eW* 

prat(17) 

aaaaa 

c 

ERM  *  0. 

TSL  *  TS(PRMT(13).X) 
prat<22)  *  pr»t<21) 

IF < PRMT (11)  .NE.  0.)  GO  TO  90 
C 

C*«  STARTUP  FOR  THE  OUTPUT  ROUTINE 
C 

RII  *  -100. /STPP 
RI  *  0. 

CURNT  < 1 )  *  X 

cupnt(2)  -  pr*t(14)  !  s#e 

CURNT (3)  »  PRMT<7)  !  cc 
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1 

I 

i 

I  curnt<4)  *  prat<13)  !  rho 

|  curnt(S)  *  prat(17)  !  litu 

curnt'.i)  3  prat(16)  !  tear 

|  CURNT (7)  *  prat<21)  !  sz 

CURNT<3>  3  Y<2)  !  » 

;  CURNT(9)  -  PRNT(8)  !  b 

|  IF<i»rat(8)  .LE.  0.)  CALL  tr*e<16) 

I  90  CONTINUE 

C 

Cm  STOP  INTEGRATION  WHEN  THE  HALF  WIDTH  B  <  0. 

!  c 

IF(  PRNT(8)  .LE.  0.)  GO  TO  1000 
C 

Cm  STOP  INTEGRATION  AND  GET  A  NEW  OBSERVER  WHEN  Cc<CcL0U 
C 

IF(PRMT(7) »GT .  CcLOW  .OR.  TSL.LT.TSTOP)  80  TO  95 

if(prat(ll>  .It.  5.)  than  !  suarantee  5 

era  3  odlp  !  fore*  output 

Soto  93 
endif 

TSTOP  *  TSL 
A6AIN  3  .TRUE. 

GO  TO  1000 
93  CONTINUE 
C 

cm  SET  THE  CURRENT  AND  PREVIOUS  RECORD 
C 

DO  100  II«l»npss 
100  DKSP(II)  »  CURNT(II) 

C 

CURNT(l)  «  X 
curnt(2)  3  prat(14) 

CURNT(3)  *  PRNT(7) 
curnt<4)  *  prat(13) 
curnt(3)  3  prat(17) 
curnt<&)  »  rrat<16) 

CURNT(7>  3  rrat<21) 

CURNT(S)  3  Y<2) 

CURNT(9)  3  PRMT ( 8 ) 

C 

RI  3  RI  +  1. 

II  3  2 

110  II  3  II  9  1 

ER1  3  ABS<  ( CURNT ( 1 1 ) -BKSP  < II >  > / ( CURNT (II) +z# ro )  ) 

ER2  3  ABS(  (CURNT(II)-OUT(II))/(CURNT(II)+zero)  ) 

ERH  3  dNAX  1 ( ER1 >  ER2 » ERH ) 

IF(II  ,EQ.  3)  II  3  II  +  1  !  skip  RH0I4 

IFCZZ  .EQ.  7)  II  3  II  +  1  !  skip  STJ8 

IF < 1 1  .EQ,  3)  II  3  II  f  1  !  skip  TEHPJ6 

IF (II  ,LT.  npss)  GO  TO  110 

r* 


VC 

CC 

rho 

iaaaa 

teap 

sz 

ssa 

b 


<  skip  DIST»YC>  1  and  2 


records 
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C***  RECORD  POINT  IF  ODLP  IS  EXCEEDED  OR  30  METERS  SINCE  LAST  RECORD 
cm  RECORD  FIRST  POINT 
C 

DX  *  CURNT(l)  -  OUT(l) 

IF (  RI.NE.I.  .AND.  ERM.LT.ODLP  .AND.  DX.LE.ODLLP)  RETURN 
C 

Cm  IF  THE  NEXT  INTEGRATION  AFTER  A  POINT  IS  RECORDED  VIOLATES  THE 
Cm  ERROR  BOUND*  THE  CURRENT  POINT  MUST  BE  RECORDED.  OTHERWISE*  THE 
Cm  LAST  POINT  TO  SATISFY  THE  ERROR  LIMITS  IS  RECORDED. 

C 

DO  120  11*1  *n«* 

IF(RI  .EQ.  RII+1.)  BKSP(II)  *  CURNT(II) 

120  OUT(II)  *  BKSP< II ) 

r 

w 

RI  *  RII 

PRMT(ll)  *  PRMT(ll)  +  1. 

C 

URITEI?**)  <OUT<II)*II»l*nMS) 

RETURN 

C 

1000  CONTINUE 
C 

Cm  STOP  INTEGRATION 

n 

w 

PRMT<12)  *  X 

C 

IF(CURNTU)  .EQ.  OUT ( 1 ) )  GO  TO  130 
C 

PRMT(ll)  *  PRMT(ll)  *  1. 

URITE(9*<)  (CURNT(II) *II*l*n?Sf ) 

C 

130  CONTINUE 
PRMT(5)  *  1. 

RETURN 

END 

**## 
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»* 


1 


U*J 


M 
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r 

C  SUBROUTINE  PSSOUT 

r 

w 

SUBROUT INE  PSSOUT (X»Y> BERT  * IHLF » NDIH » PRNT ) 

I solicit  R«slt8  (  A-H*  0-Z  )»  Inte*ert4  (  I-N  ) 

C 

include  ' sa sidedad i s  J  BEGAD I S2 . dee/ 1 i * t ' 
c 

parseeter  (nM**9>  2ero»l.e-10) 

c 

COMMON 

l/PARM/UO »Z0*ZR»ML» USTAR  »KiG» RHOE » RHOA i DELTA » BETA  > GAMMAF » CcLOU 
t/STP/STPP *  ODLP » ODLLP » STPG » 0 DLG» ODLLB 
l/PHLAG/CHECKl *CHECK2> AGAIN >  CHECK3 >  CHECK 4* CHECKS 
*/coa.fl/  cYlafl»clfl>cufl 
t/ ALP/ALPHA  >alf»hal 
C 

logical  cflad 

LOGICAL  CHECK 1 > CHECK2i AGAIN ,CHECK3 1 CHECK4 » CHECKS 
C 

REALI8  ML»K 

C 

DIMENSION  Y( 1 ) »0ERY ( 1 ) »PRMT( 1 ) 
diaension  8KSP<n*«) »0UT(nei«) r CURNT (n*ss) 

C 

Cm  OUTPUT  PARAMETERS 
C 

Cm  FROM  PSS  OUTPUT  TO  MODEL 

cm  X  BIST 

cm  PRMT(7)  Cc 

Cttt  Y(l)  SZ 

cm  Y(2)  SY 

Cm  PRMT(8)  B 

C 

ERM  »  0. 

prat<22)  *  M*et<21> 

C 

IF(PRMTdl)  .NE.  0.)  GO  TO  90 
C 

Ctt*  STARTUP  FOR  THE  OUTPUT  ROUTINE 
C 

RII  *  -100./STPP 
RI  *  0, 

CURNT  < 1 )  »  X 

CURNT (2)  *  PRMT(14)  !  ac 

CURNT' 3)  *  *rat(7)  !  cc 

CURNT <  4 )  *  i*ret<13>  !  rho 

1  --  sas Ideaad i s  J PSSOUTSS . FOR 
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CURNT(3>  3  PRMTC17) 
curnt<6)  3  prat (16) 


curnt(7) 

eurntO) 

eurnt<9) 


prat<8) 
prat (21) 
Y(2) 


!  HIM 
>  ttiP 

!  b 
!  sz 
!  » 


90  CONTINUE 
C 

Cm  STOP  INTEGRATION  WHEN  THE  HALF  WIDTH  B  <  0. 
C 

IF<  PRNT(8)  .LE.  0.)  GO  TO  1000 
C 

Ct«  STOP  INTEGRATION  when  Cc<CcL0W 
C 

IF(PRHT(7).GT.CcL0W)  GO  TO  95 


if(prat(ll)  .It.  5.)  than 
ara  3  odlp 
Soto  95 
endif 

AGAIN  a  .TRUE. 

GO  TO  1000 
95  CONTINUE 
C 

Cm  SET  THE  CURRENT  AND  PREVIOUS  RECORD 
C 

DO  100  II31 »npss 
100  9KSPUI)  *  CURNTUI) 


!  forca  output 


CURNT(l) 
CURNT (2) 


PRHT(14) 


CURNT(3)  3  prat (7) 
CURNT(4)  »  prat(13) 
CURNT (3)  3  PRHT(17) 
curnt(6)  3  prat(16) 
curnt(7)  *  prat<8) 
curnt(8)  *  prat(21) 
curnt(9)  *  Y(2> 


!  cc 
!  rho 

!  HIM 

!  taap 

!  b 


RI  3  RI  +  1. 

II  =  1 

110  II  3  II  +  1 

ER1  *  A8S<  < CURNT ( I I ) -BKSP ( I I ) ) / ( CURNT < 1 1 ) +ze ro )  ) 

ER2  =  ABS<  ( CURNT (II) -OUT ( II ) ) / ( CURNT ( 1 1 ) +za r o )  ) 

£F;M  3  dMAX  1  <  ER 1  f ER2 >  ERN ) 

IF '.11  .EQ.  3)  II  3  6  !  skip  dtnsitw»S5aa«>taap 

IF < 1 1  .LT.  np*s-l)  GO  TO  110  !  skip  sv 

C 

cut  RECORD  POINT  IF  0DLP  IS  EXCEEDED  OR  80  METERS  SINCE  LAST  RECORD 
Cm  RECORD  FIRST  POINT 
C 

DX  3  CURNT ( 1 )  -  OUT < 1 ) 

2  —  sasIdaaadislPSSOUTSS.FOR 
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IF<  RI.NE.l.  .AND.  ERM.LT.ODLP  .AND.  DX.LE.ODLLP)  RETURN 
C 

Ct»*  IF  THE  NEXT  INTEGRATION  AFTER  A  POINT  IS  RECORDED  VIOLATES  THE 
Cm  ERROR  BOUND*  THE  CURRENT  POINT  HUST  BE  RECORDED.  OTHERHISE*  THE 
C*tt  LAST  POINT  TO  SATISFY  THE  ERROR  LIMITS  IS  RECORDED. 

C 

DO  120  11*1  mpss 

IF<RI  .ED.  RII+1 . )  BKSP(II)  *  CURNT(II) 

120  OUT(II)  *  BKSP(II) 

C 

RI  *  RII 

PRMT(ll)  *  PRMT(ll)  +  1. 

C 

call  ssout(out) 

RETURN 

C 

1000  CONTINUE 
C 

Cm  STOP  INTEGRATION 
C 

PRMT<12)  *  X 
C 

IF-RI  .EO.  0.)  CALL  trar<l&) 

C 

IF ( CURNT ( 1 )  .ED.  0UT<1)>  GO  TO  130 
C 

PRMT(ll)  *  PRMT(ll)  +  1. 
call  ssaut(out) 

C 

130  CONTINUE 
PRMT<3)  *  1. 

C 

RETURN 

END 

♦*## 
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C  RICHARDSON  NUMBER  (RIX) 

C 

FUNCTION  RIF(RHOG»HEFF> 

Illicit  R»alX8  (  A-H»  0-Z  )»  Int#siarX4  (  I-N  ) 

C 

COMMON 

*  /PARM/UO » ZO t ZR » ML » USTAR »K»G» RHOE » RHOAf DELTA » BET A 1 6AMMAF * CcLQU 
C 

REALX8  ML>K 
C 

RIF  *  GX < RHOG-RHOA ) /RHOAXHEFF /UST AR/USTAR 
C 

RETURN 

END 


RICHARDSON  NUMBER  (RIt) 

FUNCTION  RIFt(tw»HEFF) 

Inplicit  R«alX8  (  A-H»  0-Z  )»  IntadarX4  (  I-N  ) 


COMMON 

*  /PARM/  UO  *  ZO » ZR » ML » USTAR » K  »G»  RHOE » RHQA » DELTA i BETA » GAMMAF » CcLOW 
t/coaata/  istabr taabf paab* Muaidr isof 1 t tsurf t ihtf 1 »htco» iutf 1 t wtco 
X/alp/  alpha»alphal 

REALX8  ML»K 

wind  3  uOX(heff/zO)XXalpha 

RIFt  3  da3Kl<GX<tsurf-ttap>/teapXHEFF/USTAR/wind»O.BO) 

RETURN 

END 


PHI  FUNCTION 
FUNCTION  PHIF(RI»rit) 

I solicit  RcalX8  (  A-H>  O-Z  )>  InttS»rX4  (  I-N  ) 


c 

coaaon  /phicoa/  ipnifl>deilaa 
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j»hif*  0. 

Soto  ( 1 0  > 1 000  >  2000 > 3000 > 9000 ) > ifhi f 1 
Soto  9000 


e 

10  IF(RI)  100 >200 >300 
C 

100  PHIF  *  0. 74/(1.  +  0.65*ABS(RI )**.*) 

RETURN 

C 

200  PHIF  *  0.74 
RETURN 
C 

300  PHIF  *  0.74  +  0.25*(RI)**0.7  +  1.2E-7*RI*RI*RI 
RETURN 

c 

c 

1000  IF(RI)  1100>1200> 1300 

c 

1100  PHIF  3  0. 88/(1.  +  0.65*ABS(RI)**.6) 

RETURN 


1200  PHIF  »  0.88 
RETURN 
C 

1300  PHIF  *  0.88  +  9.9a-2*(RI)**1.04  +  1.4E-23*RI**5.7 
RETURN 


c 

c 

2000  corrl  >  0.23*  rit**. 666666  +  1. 
corr  *  sart(corrl) 
riw  »  ri/corrl 
IF(RI)  21 00 >2200 >2300 
C 

2100  PHIF  »  0. 88/(1.  t  0.45*ABS(RIw)**.6)/corr 
RETURN 
C 

2200  PHIF  *  0.88/eorr 
RETURN 
C 

2300  PHIF  a  (0.88  +  9.9t-2*(RIw)**l .04  +  1.4E-23*RIu**5.7)/corr 
RETURN 


c 

c 

3000  corrl  a  0.23*  rit**. 666666  +  1. 
corr  *  sart(corrl) 
riw  »  pi/corrl 
IF(RI)  3100 >3200 >3300 
C 

3100  PHIF  =  0.38/corr 
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083 


i 


RETURN 


3200  PHIF  *  0.88/copp 
RETURN 

■a 

* 

3300  PHIF  *  (0.88  +  9.9e-2*(RIu)«1.04  +  1.4E-25*RIutt5.7)/copr 
RETURN 


9000  call  trap (29) 
return 
END 


function  Phihat(rho» fetch) 


Iaelicit  Real*8  <  A-H»  0-2  )»  Inteaer*4  (  I-N  ) 


coaaon 

$/j»a  n»/  uO » rO  r  z  r » al » usta  p  » k » a  »  rhoe » phoa » del  ta » beta  t  aaaaaf » ccl  ou 
1/alp/  alj»ha»alphal 
l/phicoa/  iphiflrdellas 


real*8  krai 
data  phic/3.1/ 


xf(rho  .le.  rhoa)  then 
phihat  »  0.88 
return 
end  if 

pou  »  l./alphal 
el  *  1.04/alphal 

Ci  »  a*< rho-rhoa>/rhoa<zO/ustap**2*aaaaaf/alphal 

Ci  *Ci*  <k*ustar*alphaltt2  ZuO/sO/  phic*della«/(della«-l.))  **  pou 


Zip  =  0.099*Ci«1.04 

rhihat  *  dloe<(.88+  CiPtfetcht*Pl)/,88)/Cip/fetch 
phihat  *  i,/phihat 


return 

end 
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This  routine  was  oridinallw  surrliad  by  Digital  Eauirsent 
Corporation  as  part  of  tha  Sciantific  Subroutine  Packase 
availably  for  RT-11  as  part  of  tha  Fortran  Enhanceaent 
Package.  It  was  uMraded  for  use  os  tha  integration 
routine  in  this  package* 


PURPOSE 

TO  SOLVE  A  SYSTEM  OF  FIRST  ORDER  ORDINARY  DIFFERENTIAL 
EQUATIONS  WITH  GIVEN  INITIAL  VALUES. 


USAGE 

CALL  RKGST  ( PRMT t Y » DERY » NDIM, IHLF » FCT » OUTP, AUX) 
PARAMETERS  FCT  AND  OUTP  REQUIRE  AN  EXTERNAL  STATEMENT. 

DESCRIPTION  OF  PARAMETERS 

PRMT  AN  INPUT  AND  OUTPUT  VECTOR  WITH  DIMENSION  GREATER 
OR  EQUAL  TO  St  WHICH  SPECIFIES  THE  PARAMETERS  OF 
THE  INTERVAL  AND  OF  ACCURACY  AND  WHICH  SERVES  FOR 
COMMUNICATION  BETWEEN  SUBROUTINES  OUTP  AND  FCT 
(FURNISHED  BY  THE  USER)  AND  SUBROUTINE  RKGST. 

EXCEPT  PRMT(5)  THE  COMPONENTS  ARE  NOT  DESTROYED 
BY  SUBROUTINE  RKOST  AND  THEY  ARE: 

PRMT ( 1 )  LOVER  BOUND  OF  THE  INTERVAL  ( INPUT) » 

PRMT (2)  UPPER  BOUND  OF  THE  INTERVAL  (INPUT), 

PRMT <  3 )  INITIAL  INCREMENT  OF  THE  INDEPENDENT  VARIABLE 
(INPUT), 

PRMT ( 4 )  UPPER  ERROR  BOUND  (INPUT).  IF  RELATIVE  ERROR  IS 
GREATER  THAN  PRMT<4),  INCREMENT  GETS  HALVED. 

IF  RELATIVE  ERROR  LESS  THAN  PRMT(4)*EXPAND» 

INCREMENT  GETS  DOUBLED. 

THE  USER  MAY  CHANGE  PRMT(4)  BY  MEANS  OF  HIS 
OUTPUT  SUBROUTINE. 

PRMT (5)  MAXIMUM  STEP  SIZE  ORDER  OF  MAGNITUDE  (INPUT). 
SUBROUTINE  RKGST  INITIALIZES 
PRMT (5)*'},  IF  THE  USER  WANTS  TO  TERMINATE 
SUBROUTINE  RKGST  AT  ANY  OUTPUT  POINT,  HE  HAS  TO 
CHANGE  PRMT ( 5 )  TO  NON-ZERO  BY  MEANS  OF  SUBROUTINE 
OUTP.  FURTHER  COMPONENTS  OF  VECTOR  PRMT  ARE 
FEASIBLE  IF  ITS  DIMENSION  IS  DEFINED  GREATER 
THAN  5.  HOWEVER  SUBROUTINE  RKGST  DOES  NOT  REQUIRE 
AND  CHANGE  THEM.  NEVERTHELESS  THEY  MAY  BE  USEFUL 
FOR  HANDING  RESULT  VALUES  TO  THE  MAIN  PROGRAM 
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C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


(CALLING  RKGST)  WHICH  ARE  OBTAINED  BY  SPECIAL 
MANIPULATIONS  WITH  OUTPUT  DATA  IN  SUBROUTINE  OUTP. 

Y  INPUT  VECTOR  OF  INITIAL  VALUES.  (DESTROYED) 

LATER*  Y  IS  THE  RESULTING  VECTOR  OF  DEPENDENT 
VARIABLES  COMPUTED  AT  INTERMEDIATE  POINTS  X. 

DERY  INPUT  VECTOR  OF  ERROR  WEIGHTS.  (DESTROYED) 

ERROR  WEIGHTS  ARE  CENTERED  AT  ONE.  IF  ONE  PARA¬ 
METER  NEEDS  A  TIGHTER  ERROR  CRITERIA* THE  WEIGHT  IS 
GREATER  THAN  ONE.  IF  A  PARAMETER  NEED  NOT  BE  DETER¬ 
MINED  SO  PRECISELY* THE  WEIGHT  SHOULD  BE  LESS 
THAN  ONE. IN  OTHER  WORDS* 

ERROR  CRITERIA(I)  -  PRHT(4)  /  WEIGHT(I) 
WHERE  I  IS  THE  SUBSCRIPT  OF  A  DEPENDENT  VARIABLE. 
LATER*  DERY  IS  THE  VECTOR  OF  DERIVATIVES*  WHICH 
BELONG  TO  FUNCTION  VALUES  Y  AT  A  POINT  X. 

NDIM  AN  INPUT  VALUE*  WHICH  SPECIFIES  THE  NUMBER  OF 
EQUATIONS  IN  THE  SYSTEM. 

IHLF  AN  OUTPUT  VALUE*  WHICH  SPECIFIES  THE  NUMBER  OF 
BISECTIONS  OF  THE  INITIAL  INCREMENT.  IF  IHLF  BE¬ 
COMES  GREATER  THAN  10*  SUBROUTINE  RKGST  RETURNS  THE 
ERROR  MESSAGE  IHLF*ll  INTO  MAIN  PROGRAM.  ERROR 
MESSAGE  IHLF*12  OR  IHLF*13  APPEARS  IN  CASE 
PRMT(3)*0  OR  IN  CASE  SIGN<PRMT(3) ) .NE.SIGN(PRMT(2)- 
PRMT ( 1 ) )  RESPECTIVaY. 

FCT  THE  NAME  OF  AN  EXTERNAL  SUBROUTINE  USED.  THIS 

SUBROUTINE  COMPUTES  THE  RIGHT  HAND  SIDES  DERY  OF 
THE  SYSTEM  TO  GIVEN  VALUES  X  AND  Y.  ITS  PARAMETER 
LIST  MUST  BE  X*Y*DERY*PRMT.  SUBROUTINE  FCT  SHOULD 
NOT  DESTROY  X  AND  Y, 

OUTP  THE  NAME  OF  AN  EXTERNAL  OUTPUT  SUBROUTINE  USED. 

ITS  PARAMETER  LIST  MUST  BE  X* Y*DERY*IHLF*NDIM»PRMT . 
NONE  OF  THESE  PARAMETERS  (EXCEPT*  IF  NECESSARY* 
PRMT(4) *PRMT(3) * . . . )  SHOULD  BE  CHANGED  BY 
SUBROUTINE  OUTP.  IF  PRMT(5)  IS  CHANGED  TO  NON-ZERO* 
SUBROUTINE  RKGST  IS  TERMINATED. 

AUX  AN  AUXILIARY  STORAGE  ARRAY  WITH  8  ROUS  AND  NDIM 
COLUMNS. 


REMARKS 


THE  PROCEDURE  TERMINATES  AND  RETURNS  TO  CALLING  PROGRAM*  IF 
(1)  MORE  THAN  10  BISECTIONS  OF  THE  INITIAL  INCREMENT  ARE 

NECESSARY  TO  GET  SATISFACTORY  ACCURACY  (ERROR  MESSAGE 
IKLF»11 ) * 

(2>  INITIAL  INCREMENT  IS  EQUAL  TO  0  OR  HAS  WRONG  SIGN 
(ERROR  MESSAGES  IHLF*12  OR  IHLF*13)* 

(3)  THE  WHOLE  INTEGRATION  INTERVAL  IS  WORKED  THROUGH* 

(4)  SUBROUTINE  OUTP  HAS  CHANGED  PRNT(3)  TO  NON-ZERO. 


C  SUBROUTINES  AND  FUNCTION  SUBPROGRAMS  REQUIRED 
C  ’HE  EXTERNAL  SUBROUTINES  FCT(X*Y* DERY*PRMT)  AND 
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C  OUTP < X > Y f DERY t IHLF >  ND I M » PRMT )  MUST  BE  FURNISHED  BY  THE  USER. 


C  METHOD 

C  EVALUATION  IS  DONE  BY  MEANS  OF  FOURTH  ORDER  RUNGE-KUTTA 
C  FORMULAE  IN  THE  MODIFICATION  DUE  TO  GILL.  ACCURACY  IS 

C  TESTED  COMPARING  THE  RESULTS  OF  THE  PROCEDURE  WITH  SINGLE 

C  AND  DOUBLE  INCREMENT. 

C  SUBROUTINE  RKGST  AUTOMATICALLY  ADJUSTS  THE  INCREMENT  DURING 

C  THE  WHOLE  COMPUTATION  BY  HALVING  OR  DOUBLING.  IF  MORE  THAN 
C  10  BISECTIONS  OF  THE  INCREMENT  ARE  NECESSARY  TO  GET 
C  SATISFACTORY  ACCURACY ,  THE  SUBROUTINE  RETURNS  WITH 

C  ERROR  MESSAGE  IHLF*11  INTO  MAIN  PROGRAM. 

C  TO  SET  FULL  FLEXIBILITY  IN  OUTPUT t  AN  OUTPUT  SUBROUTINE 

C  MUST  BE  FURNISHED  BY  THE  USER. 
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K  »  H  t  F(X  +H*r  ) 
4  0  3 

RELATIVE  ERROR 
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20  A<1)*.5 

A (25 *.2928932 
A<3)*1. 707107 
A< 4) =,166666? 

B(l)»2. 

3(2)=l. 

B(3)*l. 

8<4)=2. 

C(l>*. 5 
C (2) *.2928932 
C<3)»1. 707107 
CM)*. 3 
C 

Cm  PREPARATIONS  OF  FIRST  RUNGE-KUTTA  STEP 
C 

00  30  1*1 > NOIN 
AUX(ltI)~Y(I) 

AUX(2»I)=0ERY<I) 

AUX(3rI)*0. 

20  AUX(6.I)*0. 

IREC=0 

H*H+H 

IHLF*-1 

ISTEF*0 

IEND=0 

C 

cm  START  OF  A  RUNGE-KUTTA  STEP 
cm  STEP  *  2  t  SPECIFIED  STEP 

C 

40  IF< (X+H-XEND)*H)70»60»30 
50  H*XEND-X 
60  IEND*1 

r 

w 

Cm  RECORDING  OF  INITIAL  VALUES  OF  THIS  STEP 
C 

70  CALL  FCT ( X » Y  >  DERT » PRNT) 

CALL  OUTP ( X » Y » DER Y » I REC » ND I H » PRNT ) 
IF'PRHT<3>)400»80»400 
80  ITEST*0 
90  ISTEP*ISTEP+1 
C 

Cm  START  OF  INNERMOST  RUNGE-KUTTA  LOOP 

r 

W 

J*1 

100  AJ*A< J) 

BJ*B( J) 

CJ*C(J) 

DO  110  I*1>NDIH 
R1*H*D£RY(I) 

R2*AJ*<R1-BJ*AUX(6>I)) 
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yci>*ycihr2 

R2»R2+R2+R2 

110  AUX<6*I)*AUX(6*IHR2-CJ*R1 
IF ( J-4 ) 120*130*150 
120  J=J+1 

IF(J-3)130*140*130 
130  X*XtH/2 » 

140  CALL  FCT<X*Y»D£RY*PRMT) 

GOTO  100 

C 

cm  END  OF  INNERMOST  RUN6E-KUTTA  LOOP 

r 

W 

CM  TEST  OF  ACCURACY 

130  IF ( ITEST) 160* 160*200 

C 

Cm  IN  CASE  ITEST*0  THERE  IS  NO  POSSIBILITY  FOR  TESTING  OF  ACCURACY 
Cm  IF(ITEST*0)  RK  STEP  JUST  PERFORMED  HAS  FOR  TWICE  THE  SPECIFIED  STEP 
C 

160  DO  170  I*1*NDIM 
170  AUX (4*I)*Y<I) 

ITEST*1 

I STEP*ISTEP+ ISTEP-2 
180  THLF=IHLF+1 
X*X-H 
H=H/2. 

DO  190  I*1>NDIM 
Y(I)*AUX<1*I) 

DERY(I)*AUX(2*I) 

190  AUX<6.I)«AUX(3*D 
GOTO  90 
C 

CM  IN  CASE  ITEST»1  TESTING  OF  ACCURACY  IS  POSSIBLE  ONLY  IF  EACH 
Cm  HALF  OF  THE  INTERVAL  IS  D0NE(I.E. *IFF  ISTEP  IS  EVEN) 

C 

200  IMOD-ISTEP/2 

IF<ISTEP-IMOD-IMOD)210*230*210 
210  CALL  FCT(X*Y*DERY*PRHT) 

DO  220  I*1*NDIM 
AUX(5*I)*Y< I) 

220  AUX  (7*1)  *DERY I ) 

GOTO  90 
C 

Cm  ORIGINAL  VERSION  I  absolute  error 
C 

C  COMPUTATION  OF  TEST  VALUE  DELT 

C  230  DEL 7*0.  .'Good  so  far 

C  DO  240  I*1*NDIM 

C  240  DELT*DELT+AUX (8*1) *ABS ( AUX ( 4 *  I ) - Y ( I ) ) 

C  IF(DELT~PRMT(4) ) 280 *280 *230 

C 
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Cttt  RELATIVE  ERROR 
C 

230  OELT  =  0. 

DO  240  I*t,NDIM 

ARG  *  ABS<AUX(4»I)  +  Y(I) ) 

IF (ARG  .£0.  0.)  ars  *  .23*ABS(AUX(4#I) ) 

IF(ARG  <£Q»  0.)  ARG  *  ERRSET  !i t  h»r»»aux(4»i)**(i)»0,0*  r«r*0. 
RER  *  AUX(3fI)*ABS<AUXMfI>  -  Yd))/ARG 
240  BELT  *  dMAXl (BELT >R£R) 

IF(D£LT-PRMT(4) )  280>280»230 


300 

m 

m 

210 

fjjfe 

C 

cm 

cut  ERROR  IS  TOO  SREAT 
C 

230  IF ( IHLF- 10 ) 260 » 3A0 » 360 
260  DO  270  I=t»NDIM 
270  AUX(4>I)*AUX(5>I) 

C  WRITE<3»1200)  DELT 

C  1200  FORMAT! '  TRKGST?  —  ERROR  TOO  GREAT' >G13.5) 

ISTEP=ISTEP+ISTEP-4 
X*X-H 
IEND=0 
GOTO  130 
C 

C*«  RESULT  VALUES  ARE  GOOD 
C 

280  CALL  FCT(X»Y»D£RY»PRNT) 

DO  290  I*lfNDIM 
AUX(1»I)»Y(I) 

AUX(2»I)»D£RYd) 

AUX(3»I)*AUX<6»I) 

Y(I)*AUX(3»I) 

290  CERYd}*AUX(7»I) 

CALL  FCT(X-HfYiDERYrPRMT) 

CALL  OUTP<X-H»Y»DERY>IHLF»NDIM>PRMT) 
IF<PRMT(3))400»300»400 
DO  310  I*1»NBIM 
Y  ( I ) *AUX ( 1 » I ) 

BERY(I)*AUX(2»I) 

IREC=IHLF 

I F  < 1 END ) 320 1 320 1 390 


320  IHLF»IHLF-1 
ISTEP-ISTEP/2 
H*H+H 
r 

CUt  ALLOW  THE  PROGRAM  TO  EXPAND  BEYOND  ORIGINAL  STEP  SIZE  SPECIFICATION 
C«*  UP  TO  THE  MAXIMUM 

C 

IF  < IHLF+ IHLFMX ) 40 » 330 » 330 
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mm 


y.+. 


si 
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* 


S 

rcs 

1 


330  IM0D*ISTEP/2 

IF( ISTEP- IMQD- IMOD ) 40 . 340 » 40 


$ 

ft 


cm  EXPAND  H  DUE  TO  LOW  ERROR  VALUE 

C«*  ONLY  IF  TWO  CONSECUTIVE  STEPS  UITHOUT  MENTION  OF  ERROR  HAVE 
CHX*  COMPLETED.  FACTOR  USED  FOR  EXPANSION  (EXPAND)  WAS  SHOWN  TO  WORK 
Cm  REASONABLY  WELL  FOR  A  PERIODIC  FUNCTION.  VALUES  AS  HIGH  AS 
Cm  EXPAND*. S  WILL  PRODUCE  SOOD  RESULTS  FOR  MONOTONIC  FUNCTIONS. 

C 

340  IF ( DELT-EXPANDtPRMT ( 4 ) )  330,350»40 
330  IHLF*IHLF-1 
IST£P*ISTEP/2 
H*H+H 
GOTO  40 


I 


'ft 

>*5 

4 

A 

$ 

i 

t.'i 


C»*  RETURNS  TO  CALLING  PROGRAM 
C 

J 60  IHLF*11 

CALL  FCT ( X  *  Y » DER Y  *  PRMT ) 

GOTO  390 
370  IHLF=12 
GOTO  390 
380  !HLF*13 

390  CALL  FCT ( X  >  Y » DER Y » PRMT ) 

CALL  OUTP (X*Y» DERY » IHLF »NDlMf PRMT ) 
100  RETURN 
END 
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SUBROUTINE  RTMI 


c. . . . . 

c 

c  This  routine  was  orisinalla  suerlied  bw  Disital  Eauireent 
c  Corporation  as  part  of  tha  Scientific  Subroutine  Package 

c  available  for  RT-11  as  part  of  the  Fortran  Enhancement 

c  Packase.  It  was  adopted  fur  use  in  this  rackate. 

c 

. . . . . . . . . . 


c 


C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 
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PURPOSE 

TO  SOLVE  GENERAL  NONLINEAR  EQUATIONS  OF  THE  FORM  FCT(X)*0 
BY  MEANS  OF  NUELLER-S  ITERATION  METHOD. 

USAGE 

CALL  RTMI  (X*F*FCT*XLI»XRI»EPS*IEND»IER) 

PARAMETER  FCT  REQUIRES  AN  EXTERNAL  STATEMENT. 

DESCRIPTION  OF  PARAMETERS 

X  -  RESULTANT  ROOT  OF  EQUATION  FCTCX)*Q. 

F  -  RESULTANT  FUNCTION  VALUE  AT  ROOT  X. 

FCT  -  NAME  OF  THE  EXTERNAL  FUNCTION  SUBPROGRAM  USED. 

XLI  -  INPUT  VALUE  WHICH  SPECIFIES  THE  INITIAL  LEFT  BOUND 

OF  THE  ROOT  X. 

XRI  -  INPUT  VALUE  WHICH  SPECIFIES  THE  INITIAL  RIGHT  BOUND 
OF  THE  ROOT  X. 

EPS  -  INPUT  VALUE  WHICH  SPECIFIES  THE  UPPER  BOUND  OF  THE 
ERROR  OF  RESULT  X. 

IEND  -  MAXIMUM  NUMBER  OF  ITERATION  STEPS  SPECIFIED. 

IER  -  RESULTANT  ERROR  PARAMETER  CODED  AS  FOLLOWS 
IER*0  -  NO  ERROR* 

IER*t  -  NO  CONVERGENCE  AFTER  IEND  ITERATION  STEPS 
FOLLOWED  BY  IEND  SUCCESSIVE  STEPS  OF 
BISECTION* 

IER»2  -  BASIC  ASSUMPTION  FCT(XLI)*FCT(XRI)  LESS 
THAN  OR  EQUAL  TO  ZERO  IS  NOT  SATISFIED. 

REMARKS 

THE  PROCEDURE  ASSUMES  THAT  FUNCTION  VALUES  AT  INITIAL 
BOUNDS  XLI  AND  XRI  HAVE  NOT  THE  SAME  SIGN.  IF  THIS  BASIC 
ASSUMPTION  IS  NOT  SATISFIED  BY  INPUT  VALUES  XLI  AND  XRI*  THE 
PROCEDURE  IS  BYPASSED  AND  GIVES  THE  ERROR  MESSAGE  IER*2. 

SUBROUTINES  AND  FUNCTION  SUBPROGRAMS  REQUIRED 

THE  EXTERNAL  FUNCTION  SUBPROGRAM  FCT(X)  MUST  BE  FURNISHED 
BY  THE  USER. 


r 
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METHOD 

SOLUTION  OF  EQUATION  FCT(X>*0  IS  DONE  BY  MEANS  OF  MUELLER-S 
ITERATION  METHOD  OF  SUCCESSIVE  BISECTIONS  AND  INVERSE 
PARABOLIC  INTERPOLATION*  WHICH  STARTS  AT  THE  INITIAL  BOUNDS 
XLI  AND  XRI.  CONVERGENCE  IS  QUADRATIC  IF  THE  DERIVATIVE  OF 
FCT(X)  AT  ROOT  X  IS  NOT  EQUAL  TO  ZERO.  ONE  ITERATION  STEP 
REQUIRES  TWO  EVALUATIONS  OF  FCT(X).  FOR  TEST  ON  SATISFACTORY 
ACCURACY  SEE  FORMULAE  (3*4)  OF  MATHEMATICAL  DESCRIPTION. 

FOR  REFERENCE*  SEE  0.  K.  KRISTIANSEN*  ZERO  OF  ARBITRARY 
FUNCTION*  BIT*  VOL.  3  (1963)*  PP. 203-206. 


SUBROUTINE  RTMI ( X , F  * FCT *XLI . XRI *  EPS  *  I END * IER ) 
Iaplicit  R«al*8  (  A-H*  0-Z  )*  Int»S«r<4  (  I-N  ) 


PREPARE  ITERATION 

IER=0 

XL*XLI 

XR=XRI 

;;=xl 

TOL*X 

F=FCT(TOL) 

IF(F)1*I6»1 

1  FL»F 
X=XR 
TOL*X 

F=FCT(TOL) 

CF<F)2*16.2 

2  FR=F 

IF(dSIGN(l.DO*FL)+dSIGN(l.DO*FR) >25*3*25 

BASIC  ASSUMPTION  FL*FR  LESS  THAN  0  IS  SATISFIED. 
GENERATE  TOLERANCE  FOR  FUNCTION  VALUES. 

3  1*0 

T0LF*100.*EPS 


START  ITERATION  LOOP 

4  >r+i 

C  START  BIS£CTION  LOOP 
CO  13  K=1*IEND 
X=.3*(XL+XR) 

TOL*X 

FsFCT(TOL) 

IF;F>5*16»5 

5  IF < dSIGN' 1 .DO*F)+dSIGN< 1 .DO*FR) )7*6*7 


2  —  sa*  JflasalisJRTMI.FOR 


C-94 


»g| 

tVl 


l«| 


5,1 


T«| 


S 


C  INTERCHANGE  XL  AND  XR  IN  ORDER  TO  GET  THE  SAME  SIGN  IN  F  AND  FR 

6  TOL*XL 
XL=XR 
XR*TOL 
TOL*FL 
FL*FR 
FR»TOL 

7  TOLsF-a 
A»F*TOL 
A»A+A 

IF' A-FR*(FR-FL) >8,9,9 
2  IF'I-IEND>17,17,9 
0  :<R*X 
FR-F 

C  m 

C  TEST  ON  SATISFACTORY  ACCURACY  IN  BISECTION  LOOP 
TOL*£PS 
A»ABS<XR) 

IFIA-t. >11,11,10 

10  TOL*TOL*A 

11  IF(DABS(XR-XL>-T0L>12,12»13 

12  IF(DABS(FR-FL>-T0LF>14*14»13 

13  CONTINUE 

C  END  OF  BISECTION  LOOP 

C 

C  NO  CONVERGENCE  AFTER  IEND  ITERATION  STEPS  FOLLOWED  BY  TEND 
C  SUCCESSIVE  STEPS  OF  BISECTION  OR  STEADILY  INCREASING  FUNCTION 
C  VALUES  AT  RIGHT  BOUNDS.  ERROR  RETURN. 

IER=1 

14  IF(dABS(FR)-dABS(FL> ) 16,16, IS 

13  X*XL 
F=FL 

14  RETURN 
C 

C  CONFUTATION  OF  ITERATED  X-VALUE  BY  INVERSE  PARABOLIC  INTERPOLATION 
17  A*FR-F 

DX* ( X-XL ) tFL* ( 1 . t F$ ( A- TOL  >  /  C  A*  ( FR-FL > > ) ! TOL 
XM«X 


o  n  o 


<2-95 


21  IF(dABS<F>-T0LF)U>16»22 
C 

C  PREPARATION  OF  NEXT  BISECTION  LOOP 

22  IF(DSIGN< 1 .DO>F)+dSIGN< 1 .DO>FL) )24»23»24 

23  XR=X 
FR=F 

GO  TO  4 

24  XL*X 
FL*F 
XR=XN 
FR*FN 
GO  TO  4 

END  OF  ITERATION  LOOP 


C  ERROR  RETURN  IN  CASE  OF  WRONG  INPUT  DATA 
23  IER*2 
RETURN 
END 


4  —  5ss*d«s»di*:RTMI.FOR 


ooooooooooo 


PROGRAM  SDEGADIS2 


c 

Cttxttmttxtxttxttttxtttttttttttttittttttxttttttttttttttttttttttttttttttttt 

zxxxxxxxxxxxxxxxxxxxxxtxxxtxxxxxxxxxxtxxxxxttxxxxtxxxxxxxxxxxtxxxxxxxtxxtxxx 

Program  description: 

SDEGADIS2  is  a  simplif ication  of  0EGABIS2  which  performs  the  downwind 
dispersion  portion  of  the  calculation  for  a  steady  stute  source 
described  be  DEGADIS1. 


Pros ram  usaae: 

Consult  Volute  III  of  the  Final  Report  to  U.  S.  Coast  Guard 
C  contract  DT-CG-23-80-C-20029  entitled  'Development  of  an 

C  Atmospheric  Dispersion  Model  for  Heavier-than-Air  Gas  Mixtures*. 

C 

C  J.  A.  Havens 

C  T,  0.  Spicer 

C 

C  University  of  Arkansas 

C  227  Ensineerins  8uildina 

C  Department  of  Chemical  EnSineerina 

C  Fayetteville*  AR  72701 

C 

C  April  1993 

r* 

c 

This  project  uas  sponsored  by  the  U.  S.  Coast  Guard  and  the  Gas 
C  Rese;i*:h  Institute  under  contract  DT-CG-23-30-C-20029. 

C 

C  Disclaimer: 

C 

C  This  computer  code  material  was  prepared  be  the  University  of 
C  Arkansas  as  an  account  of  work  sponsored  by  the  U»  S.  Coast  Guard 

C  and  the  Gas  Research  Institute.  Neither  the  University  of  Arkansas* 

C  nor  any  person  acting  on  its  behalf: 

r 

C  a.  Makes  any  warranty  or  representation*  express  or  implied* 

C  with  respect  to  the  accuracy*  completeness*  or  usefulness 

C  of  the  information  contained  in  this  computer  code  material* 

C  or  that  the  use  of  any  apparatus*  method*  numerical  model* 

C  or  process  disclosed  in  this  computer  code  material  may  not 

C  infringe  privately  ownud  rights*  or 

C  b.  Assumes  any  liability  with  respect  to  the  use  of*  or  for 
C  damages  resultins  from  the  use  of*  .»ny  information* 

C  epparatus*  method*  or  process  disclosed  in  this  computer 


1  —  sys*deaadis:SDEGADIS2.F0R 


o  o 


c 

c 

C 

C 


Implicit  Re3l*8  (  A-Hf  Q-2  >»  Inteser*4  (  I-N  ) 

include  ' sacldessdisJ  0EGADIS2 .dec ' 
include  '(tssdef)' 


EXTERNAL  PS3  f  PSSOUT .» SSG  *  SSGGUT 


COMMON 

f/TITL/  TITLE 
I/GEN2/  DEN(5>i2en) 

t .'P  ARM/  UO » ZO . ZR » ML , USTAR fKfGi RHOE » RHOA f DELTA f BETA » GAMMAF f CcLOM 
I /coasp  top/  33S~au >  -jss-  temp >  aas-  rhoa  f aas.cpk  >  ass _cpp  f 
s  33s_ufl »a3s_lfl>aas.csp»a3s,n3«e 
l/ITI/  T 1 » TINP i TSRC » TOBS 

)/com3ta/  istabr  tambi pambi humid > isof 1 » tsurf » ihtf 1 >htco» iwtf 1 »wtco 
* /ERROR/  SYOERi ERRP f SMXP f  UTSZP f  WTSYP  f  MTBEP f  WTDH f  ERRG  f  SMXG  f 
$  WTRUHfUTDHG 

f /STP/  STPP , ODLP  f  ODLLP f  STPG  f  ODLG  f  ODLLG 

*/cob..ss/  ESS f  SLEN f  SUID » OUTCc f OUTSZ f OUTB f OUTL f sue! f swal f senl f srhl 

J/PHLAG/  CHECK 1 f CHECKS f  AGAIN  f CHECK3 f  CHECK4 1 CHECKS 

l/com_fl/  eflsaFClflFCufl 

4/NEND/  POUNDNf POUND 

l/ALP/  ALPHA Falphal 

S/?hicom/  iPhiflFdellsa 

*/sprd_ccn/  ce»  delrhomin 

t/COM_SURF/  HTCUT 


DIMENSIONS/DECLARATIONS 

1031C31  Cfl33 

resl*4  ttl 
PEAL *8  KfMLfL 

LOGICAL  CHECK 1 f CHECKS f AGA I N f CHECK3 f CHECK4 f  CHECKS 

ch3r3cter*24  tine* tsre?  tabs 
chcrscter*80  title<4) 

I  —  s  xstdesadi s : SDEBADIS2 . FOR 


o  on  n  n  o  o  o  oooon 


|  charade r*4  pound 

charade p*3  aas.naae 

i  r 

!  eharaderf4  TR2>£R2>Sr3>SSD»TR3 

i  C 

!  character*40  ornrupl 

I  character  opnrup<40) 

•  EQUIVALENCE  (OPNRUP(l) >oenru*l) 

)  c 

dimension  prmt(22)»*(4)>der*<4)>aux(8>4) 


DATA 

DATA  POUND/ '//  7  / 1 PQUNDN/- 1 , £-20/ 

DATA  TIME0/0 . / *  ND IN/0/ 

DATA  TR2/7.TR2'/>ER2/7.ER27/ 

DATA  Sr3/'.Sr37/ 

DATA  SSD/' .SSD'/iTR3/' .TR37/ 


MAIN 

T1  »  SECNDS(0. ) 
istat  3  lib«dete_tiee<TQBS) 

ifdstat  #ne.  ss ♦-normal)  stoe'libldate-tiae  failure7 

C 

C»*  GET  THE  FILE  NAME  FOR  FILE  CONTROL 

C 

read(5»U33)  nchar»oenrue 
1133  foraat<a»40al) 

C 

oenrupl  *  oenrueld Inchar)  //  ER2dJ4> 

CALL  ESTRT2ss(0PNRUPl) 

C 

cm  GET  THE  COMMON  VARIABLES  CARRIED  FROM  DEGADIS1 

C 

opnruel  *  oenrupld Jnchar)  //  tr2dJ4) 

CALL  STRT2  ( 0PNRUP1 1  H..a.js  r te ) 

C 

opnruel  *  oenruel d Jnchar)  //  sr3dJ4) 

OPEN ( UN  TT*8 » TYPE* 7  NEU 7  >  NAME*0PNRUP1 » 
i  CARRIAGECONTROL* 7 FORTRAN7) 

w 

cflas  *  isofl.ea.  l.or.  ihtfl.ea.  0 
C 

3  --  S¥54d#sadisJSBEGADIS2.F0R 


ooooooooooooo  ooo 


aRiTE-:3»m?) 
if(cflas)  then 

URI TE  ( 8 » 1 114 )  (1 00 .  *sas_l  f  1 ) > <  1 00 .  *sas_uf  1 ) » sas_zsj* 
WRITE(8f 1113) 

else 

WRITE ( 8 1 1 1 13 )  ( 100 . *33s_lf 1 ) >  < 1 00 . tsas.uf 1 ) >  3as_zsr 
WRITE<3»1117) 
endif 
WRITE(8»1119) 


1115  F0RMAT(1H0»1X»  'Distance' >2x>3x>  'Mole' >3x> 

1  'Concentration' »lxr' Density ' »2x»3x» 'Gaaaa' >4x» 

1  'Teanerature' »3x> 'Half '  >4x*4x» 'Sz' >3x»4x» 'S»' >5x» 

1  lx* 'Width  to'»3x»'Width'»/»lx»llxrlx'Fraction'»2x» 

1  llx>llx»llx»llx>3x>'Width'»3x»llx>9x* 

1  2(lr3?.3» 'aoleX' f lx) »/»lh  t 

1  99x»4x» 'at  z*  'i0rf6.2»'  »') 

1116  FORMATClHOf 1X» 'Distance' »2::#3x» 'Hole' »3x» 

1  'Concentration' » lx » 'Density' »2x» 

1  'Tearerature' »3x» 'Half ' » 4x#4x* 'Sr' »5x»4x» 'Sy' *5x» 

1  lx » 'Width  to'»3x»'Uidth'»/»lx»llx»lx'Fraction'»2>:» 

1  llx» Uxf11xf3xf 'Width' »3x»llx»9x» 

1  2fl?s9.3»'aoleX'»lx)»/»lh  » 

1  S8x»4x»'at  z*  '»0nf6.2»'  a') 

1117  FORMAT (1H  »4X» '(a) '»4x»llx> 

1  2<  1X» '  -ks/attl) '  i  lx) ,  I2x»4x» '  CK) ' f 

1  5(8X» ' (a) ' ) ) 

1113  FORMAT C 1H  ,4X> ' (a) 'f4xfHxf 

l  2(lX»'(k3/a«3)'»lx),4x»'(K)'» 

1  3(3Xf ' <a) ' ) ) 

1119  FORMAT' 1H  ) 


STEADY  STATE  CALCULATIONS 


jpnrupl  *  opnruPl(lJnchar)  //  ssd(lJ4) 
OPEN (UNIT*9  *  TYPE*'NEW ' fNAHE*QPNRUP1 ) 


AGAIN  *  .FALSE. 


L  *  OUTL 
B  =  OUTB 
S20  *  0UTS2 

4  —  sys*desadis5SDEGADIS2.FOR 


Spate  3  ESS 
QSTRO  3  Erate/2./L/B 
Cc  *  OUTCc 
wc  3  swcl 
ua  3  swal 
enth  3  sanl 
rho  3  5Phl 
c 

C3ll  satden(wc» was enth) 
c 

200  if!cflad)  then 

call  adiabat!2>tuc>tuaiS3S-lflFya>clflr P’W»t*tt) 
call  adiabat < 2 > twe » twa » sas_uf 1 > ya > cuf 1 » p t w » t » tt ) 
endif 

patiol*  uOtzO/alphal/  zOWalphal  *  cc  /b/ostrO/1 
ratio  3  patiol*  szOttalphal  *  (8  f  sartpi/2.*sy0er) 
iftratio.le.  1.)  than 

syOer  3  (l./(patiol*szO**alphal)  -  b)*2./sortpi 

alsa 

szO  3  (l./((B+  sartpi/2.*sy0ar)*patiol))**<l./3lj»hal) 

endif 

if (cc.at.  rhoa)  then 

write!lunlod>1126)  ccrrhoe 

1126  foraat!/» '  ',10('m*')»/»'  cc:  '»lpsl3.5r'  is  sreater'F 

1  '  than  phoe:  '»1ps13.5./. '  '»10! '****'),/> 

cc  3Phoe 
endif 
C 

cclay  3  cc/dellay 

call  3diabat!0fucl3y»w3l3y»ycl3y»y3l3y»ccl3y»rholay»w»enthlay»t) 
c 
C 

C***  let  everyone  know 
C 

WRITE! lunloSf 1170)  L»B 
WRITE! lunloSi 1130)  QSTROfSZO 
upite!lunlos»1135)  wclay»walay> pholay»cclay»t 
write! lunloSfll36)  wc » kw >  rho >cc* tear 

u 

1170  FORMAT! '  LENGTH:  '»1pG13.3f'  BEFF5  '»1pG13.5) 

1130  FORMAT!'  TAKEUP  FLUXJ  '»1pG13.5f'  SZO:  'f1pG13.3) 

1133  format! '  wclayl  '»1p312.5»'  walayl  '»1pS12.3» 

1  '  rholay:  '»lral2.3r'  Cclay:  '»1pS12.5f/» 

1  '  teal ayl  '»le«13.3> 

1136  foraat!'  wc:  '»1ps12.3»'  wa!  '»1ps13.3f/f 

1  '  rho:  '»1P412.3»'  Cc:  '»1p412.5»'  teap:  MP412.3) 

C 

Ct**  PREPARE  FOR  STEADY  STATE  INTEGRATION. 

C 

PRMT ! 1 )  3  1/2. 

PRMT(2)  3  6.023E13 


3  —  sysIdaaadisiSDEGADISZ.FOR 


»' 

I1 


Y 

h 


■ 

! 

h 


C-101 


PRMT (3)  =  STPP 

PRMT (4)  »  ERRP 

PRMT (5)  »  SMXP 

PRMTd)  »  grate 

PRMT(7)  =  Cc  !  OUTPUT 

PRMT<3>  »  B  !  OUTPUT 

C 

CW*  PRMT(9)  S  PRMT(IO)  ARE  CONSTANTS  FOR  D(SY)  l  D(SZ) 

C 

PRMT  <9)  a  c»*sa r t ( G*Z0/ ALPHA 1 *G AMM AF )  *GAMMAF/UO 
PRNT(10)a  Z0**AI.PHA*K*USTAR*AIPHA1  *  ALPHA1/UO 
C  PRNT(U)a  NREC 

C  PRMT<12)= 

C  PRMT<13)a 

prat (18) 3  uOtzO/slPhal 
prat(l9)a  rhoa<k*ustar*alphal 
prat(20)=  rholaa 
prat(21)-:  s  zO 
f rat (22)=  szO 
C 

Y(l)  a  rholay*prat(18)*(SZ0/z0)**alphal  !  rholaafuefffheff 
Y(2)  =  SYOER 

Y(3)  =  B  +  sartpi/2.*sy0er 
Y(4)  a  o.  !  added  heat 

C 

0ERY(1 )  *  UTSZP 
BERY<2)  =  HTSYP 
DERY(3)  =  yjBEP 
dery<4)  *  wtdh 
C 

NDIN  a  4 

C 

URITE<lunloe*1130) 

1130  FORMA T( '  Entering  Integration  Step  —  B  >  0.  ') 

C 

Cm  PERFORM  INTEGRATION 

C 

CAUL  RKGST( PRMT  > Y » DERY >NDIMt IHLF » PSS » PSSOUT  > AUX) 

C 

IF(IHLF  ,GE.  10)  CALL  trap(9»IHLF) 

C 

NREC  =  INT(PRMTdl)) 

URITE( lunlos» 1100)NREC 

1100  F0RMAT(3Xt 'NUMBER  OF  RECORDS  IN  PSS  »  'HO) 

C 

IF (AGAIN)  GO  TO  120 
C 

Cm  GAUSIAN  COMPLETION  OF  THE  INTEGRATION 
C 

Cm  PSSOUT  FORCES  THE  ABOVE  INTEGRATION  TO  FINISH  WHEN  B<0  FOR  THE 
Cm  FIRST  TIME.  THE  STEP  BEFORE  THIS  OCCURS  IS  RECORDED  ON  UNIT  7. 

6  —  sas4de*adis:SDEGADIS2.F0R 


C-102 


Cm  THE  STEP  WHEN  B  GOES  NEGATIVE  IS  CURRENTLY  IN  Y. 

C 

Cttt  THE  CALCULATION  METHOD  CHANGES  THE  CURRENT  VALUE  OF  SY  TO  A  VALUE 
C*W  CALCULATED  AS  IF  SEFF-SY  RETAINING  THE  LAST  VALUE  OF  Cc  IN  THE 
cm  MATERIAL  BALANCE » 

C 

haat  *  Y(4) 
rhola*  *  arat(20) 

Cc  *  PRNT<7) 
rhouh  *  Y  < 1 ) 

SZ  *  (  rhouh/ r Mol av/p r  a  t  ( 1 8 )  >tt(l./alphal>  *  zO 
SYT  *  ErataXALPHAl  *(Z0/SZ) WALPHA/UO/SZ/Cc/SQRTPI 
C 

XT  =  PRMT (12) 

XV  *  (SYT/RT2/D£LTA)**(1./BETA)  -  XT 
C 

cm  SET  UP  INTEGRATION  FOR  THE  GAUSSIAN  DISPERSION  PHASE. 

C 

do  i*l>22 
prat(i)  *  0. 
enddo 
c 

PRMT(l)  a  XT 
PRMT(2)  »  4.023E23 
PRMT (3)  «  STPG 

PENT  ( 4 )  a  ER RG 

PRMT (5)  »  SMXG 

PRMT(A)  a  Erato 

PRMT<7)  »  Cc  !—  OUTPUT 

PRMT ( 3 )  a  XV 

C  PRMT (9)  »  'BLANK* 

C  PRMT (10) »  'BLANK* 

C  PRMT (11) ■  'BLANK* 

C  PRMT (12)*  DIST  AT  COMPLETION  —  OUTPUT 

C 

prat(18>  *  u0*r0/3lj»hal 
prat(19)  *  rhoaXkXustarXalphal 
prmt(20)  »  rholaw 
prat(2t)  a  52 
prat (22)  *  s; 
c 

Y ( 1 >  =  rhouh 
Y(2)  *  hast 
C 

DERY(l)  *  utruh 

ders(2>  *  utdhs 

C 

MDIN  »  2 
C 

WRITE(lunloS»1140> 

1140  F0RMAT( '  Entarins  Gaussian  Stas*  of  Intasration  ') 


7  —  su sldesadis ! SDEGADIS2 • FOR 


ocjoo  o  o  o  n  c 


t*  PERFORM  INTEGRATION 

CALL  RKGST ( PRMT , Y » DERY » NDIN. IHLF  >  SSG i SSGOUT » AUX ) 
IF(IHLF  .GE.  10)  CALL  traM<10>IHLF) 

NREC  *  INT(PRNT<11)) 

120  CONTINUE 


e  CLOSE < UNIT*?) 

CLOSE (UNIT*8) 

C 

omrwl  *  o*nrm»l<linchar)  //  tr3(154) 

CALL  TRANS(OPNRUPl) 

C 

ttl  =  tl 

T1  »  SECNDS(tTl )/60. 

WRITE ( lun loa f  4000 )  TOBS 
WRITE (lunloS? 4010)  Tl 

4000  FORMAT (// » ' SDEGA0IS2  — >' *//»3X> 'BEGAN  AT  SA40) 
4010  FORMAT  <3X»'*W  ELAPSED  TIME  ttt  '»li*G13.3»'  ain') 
C 

STOP 

END 

W# 


3  --  s««<d*aadis : SDEGADIS2 .  FOR 
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C 

C 

q 

c 


TIME  SORT  SUPERVISOR 
SUBROUTINE  SORTS (TABLE) 


Implicit  R«l*8  <  A-H>  O-Z  )  »  InttttrM  (  I-N  ) 


c 

inc  1  uda  '  su stdadadi  s :  BEGAD  I  S3 .  dt c/ 1  ist ' 

C 

COMMON 

1/SORT/  TCc < aaxnob  . aaxnt ) » TCeSTR ( uxn ob » aaxnt)  » 
t  Tsc( aaxnob  f aaxnt ) » T  rho ( aaxnob » aaxnt ) » 

9  T iuu  ( aaxnob » aaxn  t )  >  T  t  tan  (  aa  xnob . uxn  t ) » 

<  TSY( aaxnob. aaxnt)  .TSZ( aaxnob .aaxnt)  .TB< aaxnob .aaxnt)  > 

9  TDIST0(aaxnob.Baxnt)»TDI3T(aaxnob»aaxnt)  .KSUB(aaxnt) 

l/SSCON/  NREC ( aaxnob  r  2) *  TO ( aaxnob ) . XV ( aaxnob ) 

1/SORTIN/  TIM(aaxnt) .NTIM.ISTRT 

1 /P ARM/  UO.ZO.ZR.ML.USTAR.K.G* RHOE . RHO A .DELTA. BETA . GAMMAF . CcLOU 
S/CNOBS/  NOBS 

C 

DIMENSION  TABLE(l) 

C 

REALY8  ML.K 

r 


CALL  GETTIM 


C 

C 


C  It* 

TABLE' I)  VALUES 

cm 

I 

PARAMETER 

ct  tt 

— 

rnntni  mm _ - _ 

cm 

1 

11 

BIST 

1  TO  10 

cm 

*» 

12 

Yc 

cm 

3 

13 

Cc 

11  TO  2< 

cm 

4 

14 

rho 

cm 

5 

13 

jfana 

cm 

6 

16 

taan 

cm 

7 

17 

SZ 

cm 

a 

13 

SY 

cm 

? 

1? 

B 

cm 

10 

20 

TS 

c 

cm 

21 

BIST0 

cm 

INTERPOLATION  FRACTION 

c 

00 

100  I  » 

1.N0BS 

c 

IT 

«  0 

c 

DO 

103  J*l> 

20 

1  —  s*std»4adis : SORTS . FOR 


W'-TM 


105  TABLE(J)  *  0 


C 

II  »  NREC(Ifl) 

if!  ii  .«q.  0)  soto  130 
c 

c* tt  read  first  record 
c 

read!9>*)  (table(kl) f kl»lf 9) 
table! 10)  »  ts<  tO(I)f  t able<l)  ) 
table(21)  a  tabled) 

c 

ettt  loop  through  and  read  each  record  even  if  not  pertinent 
DO  110  J  *  2»II 

c 

00  K1  a  1,10 
KK  a  K1  +  10 

TABLE(KK)  =  TABLE(Kl) 
enddo 
C 

READ!9ft>  (TABLE(Kl) »Klali9) 

TABLEdO)  »  TS(  T0(I)»  TABLEd)  ) 

C 

itl  »  int(  (tabledO)-tied))  /  (tie(2)-tie(l))  +  0.9999999  ) 
itl  »  ein!  ntiet  itl) 

itf  =  int<  !table(20)-tied))  /  (tie(2)-tie(l))  +  0.9999999  )  +  1 
itf  =  *a:;(  1»  itf) 

do  it  a  itf >  itl >  1  !  do  all  points  in  ranee 

C 

RECORD  AN  INTERPOLATED  TIME  SORTED  POINT. 

C 

KSUB! IT)  «  KSUB(IT)  +  1 

c 

TABLE<22)  *  (TIMdT)  -  TABLE !20) )/( TABLEdO)  -  TABLE(20) ) 

C 

TDISTO(IflT)  a  TABLE (21) 

TDIST(IflT)  »  TABLEdl)  +  ( TABLE d)  -  TABLE(ll))  *  TABLE (22) 

Tvc(I»IT)  a  TABLE(12)  *  (TABLE(2)  -  TABLE(12) )  *  TABLE(22) 

TCcdflT)  *  TABLE! 13)  +  (TABL£(3)  -  T ABLE (13) >  *  TABLE (22) 

Trftodf  IT)  a  TABLE(H)  +  (TABLE(4>  -  TABLE(14>)  t  TABLE(22) 

Taaeea( I» IT)  a  TABLEdS)  +  (TABLE(5)  -  TABLEdS))  *  TABLE (22) 

Tteee(MT)  a  TABLEdA)  ♦  (TABLEd)  -  TABLE(ld) )  *  TABLE (22) 

TSZdfIT)  a  TABLE!  17)  +  (TABLE (7)  -  TABLE(17) )  *  TABLE (22) 

TSY(IflT)  a  TABLEdS)  t  (TABLE(S)  -  TABLE(18) )  *  TABLE  (22) 

TB(IflT)  =  TABLE( 19)  +  (TABLE(9)  -  TABL£(19))  *  TABLE(22) 

C 

enddo 

110  CONTINUE 

C 
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c 


130  II  =  NREC(I>2) 

IF (II  .EQ,  0)  GO  TO  100 

DO  200  J»1,II 
C 

DO  K1  *  1,10 
KK  *  K1  +  10 
TABLE (KK)  *  TABLE(Kl) 
enddo 
C 

REA D(?>*)  (TABLE(Kl) ,K1»1,7) 

C 

TABLE (8)  »  RT2BDELTA* ( T ABLE ( 1 )  +  XV(I))**BETA 
TABLE(?)  *  0* 

TABLE(IO)  *  TS(TO!I), TABLED)  > 

C 

ltl  a  inti  <table(10)-tia!l))  /  (tia(2)-ti*(l))  +  0.9999???  ) 
itl  a  »in(  ntia,  itl) 

itf  *  int(  (table<20)-ti*<D)  /  (ti*(2)-tia(l))  +  0.99?????  )  +  1 
itf  *  ux(  1,  it f) 


do  it  3  itf,  itl,  1  !  do  all  points  in  ranse 

C 

RECORD  A  TIME  SORTED  VALUE 

C 


KSUB(IT)  a  KSUB<IT)  +  1 

TABLE<22>  a  (TIM(IT)  -  TABL£(20))/(TABLE(10)  -  TABL£(20) ) 


TDISTO<I,IT) 

TDIST(I,IT) 

Tsc<I,IT) 

TCc(I,IT) 

Trho(I,IT) 

Tsaaaa(I,IT) 

Tt«»p(I,IT) 

TSZ(I,IT) 

TSY(I»IT) 

TB(I,IT) 

C 

enddo 

200  CONTINUE 
C 

100  CONTINUE 
C 


*  TABL£(21) 
a  TABLE! 11) 
a  TABLE(t2) 
a  TABLE! 13) 
a  TABLE(tl) 
»  TABLE(IS) 
a  TABLE(16> 
»  TABLE! 17) 
a  TABLE! 18) 
»  TABLE! 1?) 


CALL  S0RTS1 (TABLE) 


C 


+ 

t 

+ 

+ 

+ 

f 

+ 


(TABLE!  1)  -  TABLE! ID)  *  TABLE(22) 
(TABLE!2)  -  TABLE(12) )  *  TABLE (22) 
(TABLE!3>  -  TABLE! 13) )  *  TABLE (22) 
! TABLE!  1)  -  TABLE(H))  *  TABLE! 22) 
(TABLEC5)  -  TABLE(IS) )  *  TABL£(22) 
(TABLED)  -  TABLE! 16))  *  TABLE! 
(TABLE (7)  -  TABLE (17))  *  TABLE! 
(TABLED)  -  TABLE! IS))  t  TABLE! 22) 
(TABLE!?)  -  TABLE!!?))  *  TABLE(22) 


RETURN 

END 


3  — .  SisIdesadislSORTS.FOR 
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SUBROUTINE  SORTS1 (TABLE) 


'4 


Implicit  Ra3l*8  <  A-H»  0-Z  )>  Intai»rt4  (  I-N  ) 


incl uda  ' s  as  *d«i ad i s ! BEGAD I S3 . d*c/ 1 i st ' 

COMMON 

S/SORT /TCc ( aaxnob » aaxnt ) • TCcSTR ( aaxnob >  aaxnt ) t 
i  Tyc(aaxnob>aaxnt) rTrho(aaxnobfaaxnt) t 

*  Tsaaaa (aaxnob* aaxnt )> Ttaap< aaxnob* aaxnt) * 

»  TSY ( aaxnob  * aaxnt ) * TSZ ( aaxnob  * aaxnt ) > TB ( aaxnob  * aaxnt ) * 

$  TO I STO ( aaxnob  * aaxn  t ) * TD 1ST ( aaxnob * aaxnt ) * KSUB ( aaxnt ) 

t/SSCON/NREC ( aaxnob *  2 ) » TO ( aaxnob ) * XV (aaxnob) 

$/SORTIN/TIM ( aaxnt ) *NTIM» ISTRT 

t/conata/  istab*taab*paab*huaid*isofl*tsurf *ihtfl*htco*iwtfl*wtco 
S/PARMSC/RN . SZM * EMAX  * RMAX » TSC 1  *  ALEPH » TEND 
t/cca.5idx/  siax.coaff >sidx-P0w**isx_ain_dist*si3x_flaS 
S/CNOBS/NOBS 


DIMENSION  TABLE(l) 


m 

% 


REAL  *8  ML  »K 
C 

C***  DETERMINE  IF  ANY  TIME  VECTORS  HAVE  NO  ENTRIES 

C 

DO  192  I=1*NTIM 

192  IF(KSUB(I) .GT .  2)  GO  TO  194  !  lor2  points  i*  of  littla  value 

call  trap<23) 

194  ISTRT  =  I 

DO  196  I*ISTRT*NTIM 
196  IF(KSUB(I) .L£.  2)  GO  TO  198 
GO  TO  199 

198  NTIM  *  I  -  1 

199  CONTINUE 
C 

C«*  REVERSE  TIME  SORTED  VECTORS 
C 

DO  200  K1  =  ISTRT»NTIM 

C 

ri  *  KSUB(Kl) 

DO  170  J  *  1 * NOBS 

c 

IF(TDIST<J*K1).NE.0.  .OR.  TB( J*Ki> .NE.O. )  GO  TO  180 
170  CONTINUE 
ISO  II  *  II  +  J  *  1 
C 

DO  190  J  *  1*11 
1  —  sasIdasadisJSORTSl.FOR 


m 
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C 

TABLE (II  +  +  1  -  J>  *  TCc(J*Kl> 

TABLEUI  +  NOBS  +  1  -  J)  *  Tyc(J*Kl> 

.  TABLEdI  +  2*N0BS  +  1  -  J)  *  Trho(JiKl) 

TABLEdI  f  3JN0BS  +  1  -  J)  *  Tsae»a( J*K1) 

TABLEdI  +  4XNQBS  +  1  -  J)  »  Tteee<J*Kl) 

TABLEdI  +  StNOBS  i  1  -  J)  *  TSY(J»K1) 

TABLEdI  +  &1N0BS  +  1  -  J)  *  TSZ(J»K1) 

TABLEdI  +  ?*N0BS  +  1  -  J)  *  TBU»K1) 

TABLEdI  +  83N0BS  +  1  -  J)  *  TDIST0(J»K1> 

TABLEdI  +  ?*NOBS  M  *  J)  !  TDIST(J*K1) 

C 

i?0  CONTINUE 
C 

DO  210  J  *  1*11 

C 

TCc;J*Kl)  »  TABLE(J) 

Tyc(J*Kl)  *  TABLE ( J  +  NOBS) 

T rho( J*K1)  a  TABLE (J  +  2*NQBS> 

Tsaaea< J*K1)  *  TABLE (J  +  3*NQ8S) 

Tte«p< J*K1)  a  TABL£( J  +  4*NGBS) 

TSY(J.Kl)  »  TA8LE(J  +  StNOBS) 

TS2( J»K1)  *  TABLE(J  +  64N0BS) 

TB(J»K1)  »  TABLE*. J  +  7BN0BS) 

TDISTO(J.Kl)  a  TABLEU  +  8*NQBS> 

TDIST(J.Kl)  a  TA8LEU  i  9*NQBS> 

C 

210  CONTINUE 
200  CONTINUE 

e 

c 

iflsittt-flad.ea.  0.)  then  !  no  correction 

c 

writedunlos**)  '  No  X-direction  dispersion  correction 
DO  220  K1  «  1STRT»NTIN 
II  *  KSUB(Kl) 

DO  220  I  =  i,il 
TCcSTR(I»Kl)  »  TCc(i*kl) 

220  CONTINUE 

return 
sndif 
C 

C»*  GENERATE  TCcSTR  —  CENTER  LINE  CONCENTRATION  CORRECTED  FOR 
Cm  DOWNWIND  DISPERSION. 

c 

DO  230  K1  »  ISTRT*NTIH 
C 

II  =  KSUBtKl) 

DO  240  I  *  1*11 

C 

c  calculation  for  XP  *  TDISTd.Kl) 


svsfdeeadis ’S0RTS1 .FOR 


TCcSTR<I»Kl)  »  0. 

C 

•  DO  240  J  *  1,11 
C 

TABIE(J)  =  0. 

c  DIST  »  TDISK  J*K1)  t  RMAX 

DIST  *  TDISTU*K1)  -  TdistO(J»Kl> 
delta  *  A8S(tdist(i»kl)  -  tdist(Jfkl)) 
c 

if (dist.lt.  sisx_ein_dist)  then 

if(i.ea.  J)  then  !  i.e.  delta  =  0. 

table(J)  =  (tdist(J+l»kl)-  tdist< J-l>kl) )/2. 
if(J.ea.l)table<J)*  (tdist(2»kl)-  tdistd.kl)  )/2. 
ifU.ea.  ii)table< J)=tdist(ii»kl)-  tdist(ii-l»kl) 
tabla(J)  =  TCe(J»kl)  /  table(J)  *  RT2JSQRTPI 
endif 

Soto  240 
endif 
c 

SX  a  sisx-coefft  DIST»»siSx_Mu 
C 

ARG  »  (delta/SX)*tt/2. 

C 

IF (ARG  .ED.  0.)  TABLE(J)  *  TCc(J>IU)/SX 
IF (ARG  .ME.  0,  .AND.  ARG  .IE.  S0.> 

S  TABLE(J)  »  TCc( J»K1)/SX/EXP(ARG) 

C 

240  CONTINUE 
C 

III  a  KSUB(Kl) 

TCcSTR(I»Kl)  »  TABLE(l)*  <TDIST(2>K1>-  TDISKKK1) )/2. 
TCeSTR(IfKl)  a  TABL£(iii>*  (TDISKiiifKl)-  TDIST(iii-l,Kl) ) 

1  t  TCcSTR(I»Kl) 

iii  *  ksub(kl)  -  1 
C 

DO  280  J  a  hi 
C 

TCeSTR(I»Kl)  =  TABLE(J)*  <TDIST(J+1>K1>-  TDISK J-l>Kl))/2. 

1  +  TCcSTR(I»Kl) 

C 

230  CONTINUE 
c 

TCcSTR(I>Kl)  »  TCcSTRd  *K1 )/RT2/SQRTPI 
c 

ctx*  correct  ac»  rho»  and  teee  values 
c 

cc  »  Tccstr(i>kl) 

if(isofl.ea.  1  .or.  ihtfl.ea.  0)  then 

C3ll  3di3bat(0»we»wa»vc>va»ce> rho»wa>enth» te«p) 

else 


3  —  s*s*desadis:SORTSl.FOR 


enth  *  Taaww<i»Kl) 

call  3di3bat(-l#wc»ua»yc»s3»cc» rho » w» » enth » tea*) 

•ndif 

Tae(i»Kl)  8  ac 
Trho(i»Kl)*  rho 

CONTINUE 

CONTINUE 

RETURN 

END 


saaldMadistSORTSl  .FOR 


C-lll 


SOURCE  EQUATIONS  —  Gas  Blanket  present 


SUBROUTINE  SRCl(tiae*Y*D*PRMT) 


Iaplicit  Real*8  (  A-H*  0-2  )»  Inteder*4  (  I-N  ) 


include  ' sysfdedadisl DEGADIS1 . dec ' 


parses  ter ( 

1 


delt~  0.1* 
delto23  delt/2»* 
7arc®  l.e-20* 
rent3  0.002) 


COMMON 

5/GEN1/  ET<2»iden) *RlT(2»iden) 

l/ERROR/STPIN » ERBND » STPMX * MTRG * WTta » HTya » utyc * u  teb  *  utab * utUH *  XLI  * 
I  XR I  *  EPS  *  ZLOU  * STP INZ  * ERBNDZ  * STPMXZ * SRCOER * s  rcss  *  c rccut * 

*  htcut*ERNOBL*NOBLpt»crfder*epsilon 

S /P ARM/  UO * 20 * ZR * ML * USTAR »K»G* RHOE * RHOA * CELT A * BETA r GAMMAF * CcLOU 
s/comata/  i3tab*taeb*paab*huaid>isofl*tsurf *ihtfl*htco*iwtfl*utco 
l/PHLAG/  CHECK 1 , CHECK2  * AGA I N  *  CMECK3 » CHECK 4 * CHECKS 
i / vucoa/  vua * vub * vue * vud » vudel t a * vuf lad 
l/coa_enthal/  h_aasrte*h_airrte*h..u3trte 
i/ ALP/  ALPHA* alphal 
t/phic am/  iphifl*dellay 
S/s?rd_con/  ce>  delrhoain 


LOG I CAL  CHECK 1 > CHECK2 > AGAIN* CHECK3  *  CHECK4 *  CHECKS 
lodical  vuflad 


REAL *3  ML*K 

REALT8  L»«asrte*Bole 

I NTEGER  R  *  mass  * aas  sc  *  aass  a  *  eba 1  *  aba 1 

DIMENSION  Y(7) *D<7) *PRMT<23) 

DATA  R/l/«aass/2/**assc/3/>asss3/4/*ebaI/S/*abal/6/ 


.f(  ?rat(2Q).lt.  O.DO?  vuflad  3  .false. 


if( YCaass)  .le.  0.00)  then 

uc  3  daa::l<prat(15)*l.d-10) 
if(uc.dt.  1.)  «c"l.d-10 
ua  3  1.  -  uc 
enthalpy  =  uc*h_aasrte 


!  air  contributes  nothind 


uc  3  Y(aassc)/Y(aass) 
ua  3  Y(aassa)/Y(aass) 
enthalpy  3  Y(ebal)/Y(aass) 


end  if 
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-N A  A  JV  A  -Vbi  A  A  .  •  ,  *  .V#.  -  a  'k  •  >  \v>W*  V  / .  /  v  / 


V-Vs/*-* 
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cal 1  tp pop ( 1 » wc i ms  t enthalpy  t y c » sa »  ao 1 e  r teap »  rho t cp ) 

RADP  *  AFGEN(  RUNTIME* 'R1TSRC' > 

hei  «  Y(aass)/Pi/Y(r)/Y<r)/rho 

hei  =  daaxl(  Y<aass)/pi/Y<r)/Y(r)/rho  »  0.D0  ) 

del r he  »  pho-phoa 

dpriae  a  a»dt lrho/rhoa  thei 

CM*  CALCULATE  B(R) »airrte*vel 

D(R)  a  0. 

V<?1  =  0. 
sirrte  a  o. 

Ri  a  0. 

D(obal)  a  o. 

IF<Gpriae»GT.  0.)  then 
slump  a  Cetsa rt<Gpriae) 

if(vuflas)  then  !  acaentua  balance 

iii  a  o  !  initialize  loop  counter 

vel  3  prat<14)  !  old  velocity  value 

velain  3  o. 

velaax3  daaxl(  slump*  0.1D0»  vel) 

100  hh  *  vel*vel/Ce/Ce/a/  <deirho/rhoa) 

rh  3  Y( r)-vua*vub*hh 
value  3  Y(r)Mt2/ph**2 

if (prat(23).Se.  prat(24))  then  !  hh  .ae»  ht 

ht  =  2.*(value*hei  -  vua*hh*(value-l.))  -  hh 

velc  3  Y(abal)/(0.4*ei*rho*(2./3.*ht  +  hh)trh«3/Y(p) 

1  +  2./3.*Pi*vua*rho*hht  <YCr>»2  -  rhtrh*rh/Y<p>) 

2  +  vue*pi*Y<r)*hei«2*rhoa) 

D(abal)  3  pi*g*delrho*Y(r)*ht**2 

1  -  vu3*vud*ei*rhoa*Y<r)*hh*vel«2 

else 


ht  *  value*hei  -  vua<hh*(value-l.) 
velc  3  Y<aba,l)/(2./3.»Pi*pho»ht*ph«3/Y(p) 

1  +  2./3.*pi*vua*pho*hh*  <YCr>**2  -  rh*rh*rh/Y(p) > 

2  +  vue*ri*Y< p)*hei*t2trhoa) 

D(abal)  a  pi*s*del  rho*<  ph*ht«2  4  vu3*vub*hh*hh*hh) 
1  -  vuafvudfPitrhoa$Y(p)*hh<v<?l**2 

endif 


vel  *  (vel+velc>/2 
prat(13)  ~  vel 


if (vel  .at.  0.)  then 
Ri  =  appiee  /  veltt2 

3irrte»  2.*Pi*  ePsilon/Ri  *rhoa*Y(r)*hei*  vel 
D<r)  =  vel 
prat(20>  3  slue* 
endif 

else 


dif  3  vel-vele 

if(velc. It. velein)  velein3  deinl(velc>  0.D0) 
if(velc.dt.velaax)  velaax3velc 

if(dif  .St.  0.)  then 
veleax  *  vel 

vel  3  O.SDOIKveleax-velain)  +  velein 

else 

velein  3  velc 

vel  3  (1 .B0-O.3DO)*<veleax-velain)  +  velein 
endif 

iii  3  iii+1 

if(iii  .at.  40)  stop'SRCl  velocity  loop' 

Soto  100 
endif 


else 


vel3  sluep  !  aravity  sluarina 

hh  3  hei 
ht  3  hei 

Ri  3  dpriee  /  vel**2 

airrte3  2.*ri*  eesilon/Ri  *rhoa*Y(r)*hei*  vel 
D(p)  3  vel 
endif 
endif 


IFCdelrho.Lt.delrhoein  .and.  .not.(check2  .op.  uO.ea.O.)) 

1  D<R)  3  0.  !  not  fop  HSE  tyres  op  no  wind  cases 

area  3  Pi  t  (Y(r)**2  -  radrM2> 

IF (Y(R) ,LT ,  RABP)  THEN 
AREA  3  0. 

Y(R)  3  RADP 

IF(tine.3t.  delto2)  then  !  delt)  nue  ppob 
D(R)  3  deaxl(0.D0> 

1  ( ( AF5EN (RI T  >  TIME+delto2  > 'RI TSRD ' ) - 

sysldeasdis JSRCl .FOR 
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2  AFGEN<R1T»  (TIME-dt lto2) t 'RlTSRt' ) )/  delt>> 

else 

0(R)  3  daa;:l(O.DO» 

1  ( (AFGEN(R1T  »delto2> 'R1TSRD' )- 

2  AFGEN(R1T»  0. * 'RITSRe') )/  deito2> ) 
and  if 

END  IF 
c 

c  calculate  totrtaout 
c 

aasrte  3  AFG£N(ET»TINE»  '3rd') 

L  3  SQRTPI  *  Y<R) 


cc  3  uc*rho 


ustrax  3  0. 
if < uO  .ne.  0>) 

1  astrax  =  cc*K*USTAR*ALPHAl*dellay/(dellau-l.)/i»hih3t(rho»L) 


c 

c 

astrll  s  astrax  t  L*L 
totrtaout  3  astrll/uc 

c 

c  surface  effects 

c 

uatrte  3  0. 

surfaces  ~  0. 

call  surface < tea* » he  i » rho » aole » cr > wat rte > su r f ace.a ) 
surface-a  =  area  *  surface-a 

if< surface_a.lt.  0.)  surface-a  3  0.  !  don't  let  the  cloud  cool 
uatrte  =  area  *  uatrte 

c 

500  totrtein  3  airrte  +  aasrte  t  uatrte 


IF< totrtein. It. totrteout  .and.  .not.ctieck2 
1  )  then  !  check2  is  True  for  HSE  tw*e  seills 

D(R)  3  0. 

totrtein  3  airrte  +  aasrte  +  uatrte 
endif 

CALCULATE  D(aass) »D<aassc) ?D(aassa> »D(an«thins  left) 

D(aass)  3  totrtein  -  totrteout 

D(aassc)  3  aa-jrte  -  autrll 

IHaassa)  3  airrte/Cl .thuaid)  -  ua/uctastrll 

0<ebel)  3  0. 

if(ihtfl.ne.  0)  !  eouivalent  to  adiabatic  aixins  froa  TPR0P  for  ihtfl30 
1  D<ebal)  3  h_aasrte*aasrte  *  h-airrtelairrte 

1  +  h.uatrtetuatrte  -  enthaleyttotrteout  +  surface-a 

—  susidesadisJSRCl .FOR 
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uheff  *  astrax*L/cc 

S2  *  0. 

if'uO  .ne.  0.)  S2  =  <  uheff*alehal/u0/20  )tt(l./alPhal)  t  zO 
c 
c 
C 

PRMT(6)  *  QSTRMX 
pp»t(7)  *  S2 
rr#t<8)  *  hei 
pp»t(?>  *  rho 
pr»t(10)3  Ri 
prut (ll)3  sc 
pPBt(12)=  S3 

ppmt(13)s  D(p) 

?rnt(l£)  =  wc 
pp«t(17)  =  us 
ppmt(18>  -  enthalpy 
pri»t<l?)  =  te*p 
?r»t(21>  *  aasrte 
p  pint  (22)  =  ht 
pp*t(23)  =  hh 
RETURN 
END 


SUBROUTINE  FOR  OUTPUT  FROM  SOURCE  in  the  presence  of  a  Blanket 
SUBROUTINE  SRC10 < TIME » Y  >  DER  Y  >  IHLF » NDIN  > PRMT ) 

Iaplicit  RealtS  (  A-H»  0-Z  ),  Intesep*4  (  I-N  ) 


C 

include  'sssideaadisJDEGADISl .dec' 

C 

COMMON 

5/ERROR/STP I N » ERBND  t STPNX i WTRG >  WTU  > MTsa >  wtsc  >  wteb » wtab » wtuh » XLI > 
t  XRI >  EPS  *  ZLOH » STP INZ  >  ERBNDZ , STPMXZ  »  SRCOER  t s  rcss  > srccut » 

I  htcut  t ERNOBL » NOBLpt » c  r f 3e  p * epsi 1 on 

t /P ARM/  HO » ZO » ZR » ML ; USTAR » K » G f RHOE » RHOA » DELTA, BETA » GAMMAF fCcLOM 
t/PARMSC/  RM » SZM , EMAX  , RMAX ,TSC1, ALEPH , TEND 

$/coa_ss/  ess, sl0n>swid»autcc,oijt32»outb,outl ,fwcl»swal,*enl,srhl 
*/PHLAG/  CHECK 1 >  CHECK2  ,  AGAIN  , CHECX3 >  CHECK4 , CHECKS 
*/4LP/  ALPHA, alphal 
C 

LOG I CAL  CHECK 1 , CHECK2 , AGAIN , CHECK3 , CHECK4 , CHECK5 

C 

DIMENSION  Y(£) ,DERY(6) »PRMT(23) 

3  —  sssIdeisdisJSRCl .FOR 
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DIMENSION  C'JRNT(iout-SPC) »8KSP(iout-SPC) »OUTP(iout_sre) 

C 

DATA  I/O/ » III/O/ 

DATA  EMAX/0./»tlast/0./ 

w 

REAU8  ML»K 

INTEGER  R.aassMtassoaassa.ebal 
DATA  R/l/i  mss/2/  t mssc/3/  *  aassa/4/ » ebal/3/ 
c 

d3ta  nracl/O/ 

C 

1*1  +  1 
III  *  III  +  1 
C 

dStP  *  PPat(6) 
sz  =  »»rat  (7) 
hei  *  prat(8) 
rho  *  ppat(9) 

Ri  *  prat(lO) 
sc  *  prat(ll) 

S3  3  Pr«t(l2) 
vel  *  »rat(12) 

?rat (14?  *  val 

if (vel  .at.  prat(20))  prat(20)  *  -prat(20) 
prat(13)  *  pratUA)  !  wc 

wc  *  ppat(16) 
cc  »  hc  *  rho 
ua  *  ppat<l7) 
enthalpy  *  ppat(18) 
teap  *  prat (19) 
prat(24)  ■  prat(22)  !  ht 

prat (25)  *  ppat(23)  !  hh 

c 

IF (hei  .La.  0.0)  GO  TO  1000 
C 

QSAV  *  PI«Y(R)*Y(R)*astr 
IF (OSAO  ,LT.  EMAX)  GO  TO  110 
EMAX  *  OSAO 
RM  *  Y(R) 

3ZM  *  SZ 
110  CONTINUE 

RMAX  *  dMAXKRMAX*  Y(R) ) 

C 

IF (hei  .La.  spccut)  GO  TO  1000 

if(cc  .la.  celow  .and.  uO  ,aa.  0.)  3oto  1000  !  no  wind 

if (tiee.dt.tend+l.  .and.  uO.eo.O.  .and.  vel.ea.0.)3ota  1000'no  wind  LNG 
C 

IF(I  .NE.  1)  GO  TO  115 
CURNT(l)  *  TIME 
CURNT(2)  *  Y(R) 

CURNT ( 3 )  *  hei 
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CURNT ( 4 )  =  ostr 
CURNT(3)  =  sz 
CURNT  <  6 )  *  ye 
CURNT (7)  «  ya 
CURNT<3)  =  rho 
CURNT (?)  *  ri 
CURNT! 10)*  uc 
CURNT(ll)*  ua 
CURNT (12) «  enthalpy 
CURNT!13)*  t eap 
III  *  1 
ilO  TO  125 

115  IF < I  .Ed.  0)  RETURN 

r» 

w 

DO  116  II*l»iout_src 

116  BKSP(II)  *  CURNT! II) 

C 

C'JRNTU)  =  TIME 
CURNT (2)  *  Y(R) 

CURNT! 3)  *  hei 
CURNT! 4)  =  astr 
CURNT! 3)  ■  32 
CURNTI6)  =  «c 
CURNT (7)  3  ya 
CURNT! 3)  »  rho 
CURNT!9)  3  ri 
CURNT! lO)*  wc 
CURNT!11)3  ua 

CURNT! 12)«  enthalpy 
CURNT!  13)3  tnp 
C 

ERM  *  o. 
erass  3  o. 

DO  120  Il32iiout_src 

div  !  cumt(ii) 

if (div  .to.  0.)  div  *  sreotr 

ER1  »  ABS!  !CURNT!II)-BKSP!II))/div  ) 

ER2  *  ABS!  !CURNT!II)-OUTP!II))/div  ) 

if(II.ne.3  .and.  ii.ne.9  .and.  ii.nt.12  .and.  ii.nt.7  .and.  zi.ne.ll) 

1  trass  *  dMAXl!ERl»ER2»ERHss>  !  ex  hei»QSTR»Ri>enth»ua*ya  for  SS 

120  ERM  *  dNAX 1 <  ER 1 >  ER2 1 ERM ) 

C 

if!chtcK4)  then  !  steady  state 

if!  .not.  (vel.eo.  0, .and.tiae.st.srcss) )  Soto  124 
122  eheck.3  3  .true. 

outcc  *  wc  *  rho 
sucl  *  uc 
sual  *  ua 
srhl  ■  rho 
senl  =  enthalpy 
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aster  »  eret<2i)/>i/Y(r)<*2 

iffyO.ne.  0.)  sz  3  (alPhal/uO/zOOTstartoutl/outccXSfl./alehai)  *  zO 
outsz  a  sz 
cutb  a  outl/2. 
dots  1000 

124  if(er»ss  .st.  *pcotr)  soto  12S 

iff  tiee-tlast  .St.  sress)  Soto  122 

return 

endif 

c 

IFfERM  .LT.  SRCOER)  RETURN 
C 

125  CONTINUE 
tlast  a  tine 

DO  130  IIai»iout_sre 
IF(III.EQ.l)  BKSP(II)  *  CURNTdl) 

120  OUTP(II)  =  BKSP(II) 

C 

III  a  0 

MREC1  a  NREC1  +  1 

URITE(9>2000)  <OUTPdI)»II*l»iout.src) 

RETURN 

C 

1000  CONTINUE 
I  a  -1 

IFfTIME  .GE.  TEND)  CHECK3  «  .TRUE. 

NREC1  a  NREC1  +  1 
WRITE <lunloS» 1100) 

WRITE ( lunloSf t)  Heir  TINE 

rsci  a  tine 

if (hei  .1*.  0.)  then 
hei  a  o. 

y(r)  »  d*inl<reax»*<r)) 
endif 
WRITE(9.2000) 

1  TINE  . Y ( R ) » hei » ost  r  > s z»  «c»  wa » rho » r i i uc » wa » enthale* » teee 

WRITEdunloS.il  10)  NREC1 
C 

PRNT(S)  *  1. 

C 

RETURN 

1100  FORMAT (5X» 'VALUE  OF  Hei  AT  SOURCE  TERNINATION  —  9  TINE') 

1110  FORMAT <3X»' NUMBER  OF  LINES  — >  '.18) 

2000  for*atdPSl6.9»lx»leSl6.9»<iout_src-2>(lx»leSl3.6) > 

END 

**#* 


3  —  s*s Idesad i s 1 SRC 1 . FOR 


SUBROUTINE  SRTOUT(OPNRUP) 


Illicit  Real*8  (  A-H»  0-2  )»  Inteder*4  (  I-N  ) 

i  nclude  '  sms  ddedaii  i  -i  5  BEGAD  I  S3 .  dec/ 1 1  s  t ' 

COMMON  /SORT/TCc ( aaxnob  »aaxnt > » TCcSTR ( aaxnoi b » aaxnt ) > 
t  T  sc  ( aaxnob  »  aaxnt )  t  T  rho  <  aaxnob  >  aaxnt )  ? 

I  T  daaaa <  aaxnob * aaxn t)  >T tea? <  aaxnob » aaxnt ) t 

$  TSY ( aaxnob  > aaxnt) « TSZ ( aaxnob  >  aaxnt ) >TB< aaxnob » aaxnt ) t 

*  TDISTO (aaxnob* aaxnt) «TB I ST (aaxnob* aaxnt) *KSUB(aaxnt) 

t/SORTIN/TIM(aa;:nt) *NTIM* ISTRT 

I /coa.dp r  op/  das.au * das. teap  * das. rhoe  * das.cpk.  * das.cpp  * 

I  das  .  uf 1 *  das. 1 f 1  * ^s.zsp . d a  s.naae 

S/coaata/  istab>t3Bb>paab>huaid*isofl*tsurf * ihtfl*htco*iutfl*utco 
S/coa.sidx/  sidx.coeff  *5idx..poH*sidx_ain..dist*sidx_flad 
t/al?/  3lpha»alphal 

lodical  cflad*cfladl 

character*3  das.naae 
characterMO  OPNRUP 

OPEN (UNIT =8 * TYPE* ' NEW ' * NAME*0PNRUP > CARRIAGECONTROL*' FORTRAN ' ) 

WRITE(3»1100) 
if (sidx-flad.ee.  0.)  then 
urite(8*1102) 

else 

urite(8*1104) 

urite(S* 1105)  sidx.coeff *sidx_pou*sidx_nin_dist 
endif 

cflad  *  isofl.ee.  I.op.  ihtfl.ee.  0 
cfUdl=  isofl.ee.l 
if (cflad)  then 

call  adiabat(2»wc>M3»das_lf l**a*cc_lfl*r*w*t*tt) 
call  adiabat(2>wc*H3*das_ufl**3*cc_ufl*r*w*t*tt) 
endif 

DO  110  I*ISTRT*NTIM 

WRITE(8*111?) 

MRITEO*  1119) 

HRITE(8* 1110)  TIM(I) 
if(cf  1-J21)  then 

URITE(3»1116)  ( 100 . tdas.l f 1 ) » < 100 . Idas.uf 1 ) * das-zsp 
WRITE(8*1118> 

else 

MRITEO*  1115)  ( 100 .tdas.lf 1 ) * < 100.*das_uf 1 ) » das-esp 
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WRITE i8t 1117) 
end  if 
WRITE <8f 1119) 
i?  *  0 
II  »  KSUB(I) 


DO  120  J»1»II 


cc  »  tccstp(j»i) 
pho  *  Trho(Jfi) 
ac  =  Tac(Jri) 
ten*  =  Tteae(J»i) 
tsaaa  a  Tsaaaa<J»i) 
b  =  tb(J»i) 

52  =  tS2(J»i) 

sa  =  tsa(J»i) 

bin  =  o. 

buf 1  =  0 . 


if < .not.cflas)  then 

call  adiabat<'2>uc>wa»das-lfl»*s>cc.lflf rrwrsaaaartt) 
call  adi abat  < -2 met wa t sas.uf 1 /ear cc.uf 1 / p » w r saaaa r 1 1 ) 
endif 


are  a  ( aas_2sp/sr ) ttalphal 
if(3P2  .3e,  30.1  soto  400 


ccz  *  ce/exe(apa) 
if(ccz  .It.  cc-lfl)  then 
if(cflasl)  then 

URITE(9»1120)  TDIST( J»I) »ac»Cc»rho»tea*»B»SZ»SY 
else 

WRITE(8»1120)  TD I  ST  <  J » I )  *  ac » Cc » pho  t Sanaa t tene » B » SZ » S Y 
endif 

Soto  600 
endif 

a ps  *  -(<jloS(cc_lfl/cc)  +  (sas_2s^/sz)*»alphal) 
blfl  »  sc  't(ars)*sa  +  b 


if (ccz  .It.  cc.ufl)  then 
if(cflasl)  then 

WRITE<8»1120)  TBIST( J» I) >sc*Ccf  pho»teae>B»SZi SY»blfl 

else 

WRITE(8» 1120)  TDIST< J»I)»ae»Cc»pho»saana»tene»B»SZiSY»blfl 
endif 

Soto  600 
endif 

a ps  »  -(dloS(ce_ufl/ec)  ♦  <sas.zse/sr)**alphal) 
buf  I  *  sapt(aps)*sa  t  b 
if (cflasl)  then 

WRITE'S, 1120)  TDIST<JtI),*c,CctrhotteartBtSZ,SYtblfl>b<jfl 
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else 

WRITE (8> 1120)  TDIST !  J » I )  >  ac » Ce  > rho » saaea » tea* » B  *  SZ  >  SY » bl f 1 >  buf 1 
end  if 

c 

600  continue 
ip  3  ip  +  1 
if!ip  ,ea.  3)  then 
i?  3  0 

write!8illl9) 

endif 

120  CONTINUE 
110  CONTINUE 
C 

CLOSE (UNIT=8) 


1100  FORMAT !1H0»5X> 'Sorted  values  for  each  specified  tiae.') 

1102  foraat!lH0»5x> 'X-Direction  correction  was  NOT  applied,') 

1104  foraat!lH0»3x» 'X-Direction  correction  was  applied.') 

1105  foraatUh  »3x#5x# 'Coefficient:  ' >lPdl3.3»/> 

1  lh  »5x»5x» 'Power:  '»1ps13.5>/> 

1  lh  >5x»5x» 'Ninieue  Di stance:  '»1ps13.5'  s') 

1110  FORMAT !1 HO »5X» 'Time  after  beainnins  of  spill  SG14.7*'  sec') 

1115  FORMAT! 1H0, IX » 'Distance' »2x>3x* 'Mole' »3x> 

1  ' Concent  ra tion ' > lx  > ' Density ' » 2x  r 3x » ' Gaaaa '  >  3x » 

1  ' Teeperature ' * 3x> 'Hal f '>4x>4x> 'Sz' t 5x»4x» ' Sw ' • 5x» 

1  Ixf 'Width  to' >3x» 'Width' »/»lx»llx»lx'Fraction'»2x» 

1  Ux»llx»llxrllx»3x» 'Width' »3x»llx»9x* 

1  2(lPd9.3»'eoleZ'»lx)»/»lh  > 

1  ?9x>4x>'at  z*  '»0pf6.2>'  a') 

1116  FORMAT! 1H0»1X» 'Distance' >2x>3x» 'Mole' »3x> 

1  ' Concentration 'tint' Dens i tw ' • 2x  t 

1  'Teeperature' »3x» 'Half '»4x>4x> 'Sz' »5x»4x> 'Sw' »5x» 

1  V/.f  'Width  to' >3x» ' Width' »/»lx»llx» Ix'Fraction ' »2x» 

1  Ux>llx>llx>3xr 'Width' >3x>llx»9x> 

1  2(1p39.3» 't»olsX'*lx)»/rlh  t 

1  88x>4x> ' 3t  z3  ' »0pf6.2» '  s') 

1117  FORMAT ! 1H  »4Xr ' (») ' *  )x>tlx» 

1  2!lX>'!kS/a**3)'>lx)>llx>4x»'!K)'» 

1  3<3X» '(a)')) 

1118  FORMAT! 1H  >4X> ' !*) ' f 4x>llx> 

1  2(1X>  '(ks/a«3)'»lx)»4xp'!K)'» 

1  3!SX» ' (a) ' ) ) 

1119  FORMAT (1H  ) 

1120  FORMAT !1H  »3!lXilP89,3»lX)»2x»0pf7,4»2x>lX»lPG:lO.3»lX» 

1  6!1X»1PG9.3»1X)) 

RETURN 

END 

m# 
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SUBROUTINE  SSG<DISTf Yf D»PRMT) 

Illicit  Rtal*8  <  A-H#  0-Z  ),  IntM»p*4  (  I-N  ) 

DIMENSION  Y(l)iD<l)»PRMT(l) 
include  's*s»dadadis:DEGADIS2.dae' 
psraaeter  <zepo*l.D-10f  pepit*2.5D-3) 

COMMON 

S/PARM/UO *  ZO » ZR » ML » USTAR  »K»G» RHOE  *  RHOA . DELTA » BETA » GAMMAF , CcLOW 
t/couta/  istab >  taab » aaab t huaid >  isof  1 » tsurf » ihtf 1 1 htco » iutf  1 1 wteo 
l/ALP/  ALPHA>alf»hal 
t/phicoa/  iPhiflrdellav 

REAL 18  KtML 

INTEGER  Phouh.dh 
DATA  rhouN/l/tdh/2/ 


cm  PRMT  (1)  1/0 

cm 

i 

VALUE 

IN/OUT 

r+Tt'* 

cm 

6 

E 

IN 

cm 

7 

Cc 

OUT 

cm 

8 

XV(I) 

IN 

cm 

9 

TOU) 

IN 

cm 

10 

- 

- 

cm 

11 

NREC( If 2) 

OUT 

cm 

12 

DIST 

OUT 

cm 

13 

sz 

cm 

14 

nc 

out 

cm 

13 

pho 

out 

cm 

16 

tMH» 

out 

cm 

17 

iaaaa 

out 

cm 

18 

cm 

19 

cm 

20 

rholay 

cm 

21 

sz 

XVI  *  PRMTO) 

SY  «  RT2*DELTA*<DIST  f  XV1)«8ETA 
Erata  *  PRMT(6) 


szO  *  pr#t(22) 
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■c 


H 


sz  *  szO 
C 

CtB  MATERIAL  BALANCE 
C 

iii  =  0 

100  Cc  *  E r atefALPHAl * ( ZO/SZ ) ALPHA/UO/SZ/SQRTPI/SY 
c 

call  3disbat(0iuouatao*3'co rho*wa*enth»teap) 
cclaa  *  ce/dellaa 

call  adiab3t(0twowaracl3a»aa>cclaa»rholastual»enth»tealaa) 
call  addhaat ( ccl aa * Y ( dh ) » rhol au * tealaa t cp ) 
prod  =  daaxl(  Y(rhouh)/rhol3s/prat(18)»  zero) 
sz  *  (  prod  )  **<l./alphal)  t  zO 
dif  -  3bs(sz  -  sz0)/(3bs(sz)+3bs(sz0)+zero) 
ifCdif.St.  rcrit)  then 
iii  *  iii+1 

if (iii. at*  20)  call  trap(33) 
szO  =  sz 
doto  100 
sndif 

prat(20)  =  rholaa 
prat(21)  =  sz 
HEFF  *  GAMMAFtSZ/ALPHAl 
rit  =  0. 


teap  =  tealaa 

ifCisofl.eo.O  .or.  ihtfl.ne.0)  then 

rho  a  dellaa<( rholaa-rhoa)  t  rhoa 
teap  a  (ua/rho)t<  rholaattealaa/wal) 
rit  =  rift(teap»iieff ) 
endif 


!  estiaate 
!  estiaate 


RISTR  =  RIF ( RHO , HEFF) 

PHI  a  PHIF(RISTRtrit) 

d(rhouh)  *  prat(l?)/phi 
hwish  »  hefftdellaa 

call  surface( teal3s>heiSh»rholaa»walfCP»watrte»arte) 
if(teap.se.  tsurf  .or.  tealaa.se.  taab)  arte  »  0. 
d(dh)  *  (  opte/dellaa-Y{dh)*D(rhooh)  )/Y(rhouh) 


PRMT(7)  a  Cc 

PRMTC12)  »  0IST 

prat(l4)  a  ac 

prat(15)  a  pho 

prat (16)  =  teap 

rrat<17)  *  (rholaa-rho3)/ccl3« 

RETURN 

END 
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C 

SUBROUTINE  SS60UT (X>Y>Dt IHLF »NBIN» PRMT ) 

C 

Iaelicit  RealX8  (  A-H»  0-Z  )»  Intesar*4  (  I-N  ) 

include  '  s  ustdeesd  i  s :  DEG  AD  I S2 .  <J  ec ' 
c 

paraeeter  (nss3*7*  zepoal.e-10) 
c 

D IMENSION  Y ( 1 ) , D <1 ) » PRMT { 1 ) >  BKSP < nssa ) > OUT ( nssa ) > CURNT (nssa) 

C 

COMMON 

1/PARM/  U0>Z0»ZR*ML» USTAR  *K>G*RHOE* RHOA * DELTA* BETA  *  GAMMAF * CcLOU 
S/coaata/  istab*  taab*paab*huaid» isof 1 » tsupf * ihtf 1 *htco* iwtf 1 *wtco 
l/STP/  STPQ *  STPP * ODLP  *  ODLLP » STPG » ODLG  > ODLLG 
S /STOP IT/  TSTOP 
c 

REAL *8  K*ML 
C 

C*«  PARAMETER  OUTPUT 

cm  FROM  SSG  OUTPUT  TO  MODEL 

cm  -  - 


cm 

X 

DIST 

cm 

PRMT(7) 

Cc 

cm 

Y(l> 

SZ 

cm 

pr»t(14) 

ac 

cm 

pr«t(15) 

pho 

cm 

prat<16) 

teap 

cm 

ppat(17> 

aaaaa 

c 

ERM  »  0. 

T01  a  PRMT(?) 

TSL  *  TS(TOl.X) 
pp«t<22)  *  ppat(21) 

!  SZ 

c 

IF'PRMT(ll)  .NE.  0.) 

GO  TO  90 

c 

cm 

STARTUP  FOR  OUTPUT  ROUTINE 

c 

RII  *  -100. /STPG 

RI  =  0. 

CURNT  < 1 )  *  x 
curnt(2)  *  *rat(14) 

!  *c 

CURNT (3)  «  PRMT ( 7 ) 

!  cc 

curnt<4>  «  ppat(13) 

!  pMo 

curnt(3)  *  ppat(17) 

!  aaaaa 

curnt<6)  *  ppat(16> 

!  tea? 

C’JRNTC)  »  Prat<21> 

!  sz 

1  —  sas*d*aadi353SG0UT.F0R 
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C 

90  CONTINUE 
C 

Cm  RECORD  THE  CURRENT  AND  PREVIOUS  RECORDS 
C 

RI  a  RI  +  1. 

c 

DO  100  11=1, nsss 
100  bksp(II)  =  eurnt(II) 
c 

CURNT(l)  »  X 

curnt(2)  3  J»r»t ( 14)  !  ac 

CURNT (3)  =  PRHTI7)  !  ec 

curnt<4)  3  prat(13)  !  rho 

cumt(5)  *  prat<17)  !  saaaa 

cumt(6)  3  prat(lA)  !  tea? 

CURNT ( 7 )  3  i»Pf»t<21)  !  s= 

C 

cm  stop  integration  when  ceCcelow  and  tiae  is  satisfied 
C 

IF < PRMT ( 7 ) . LT . CcLQU  .AND.  TSL.GE.TSTOP)  GO  TO  1000 
C 

C*tt  CHECK  FOR  OUTPUT 
C 

DO  110  11=3, nssd 

ER1  a  ABS<  ( CURNT (II) -BKSP< !!)>/( CURNT ( II ) +zero )  ) 

ER2  =  ABSI  (CURNT(II)-OUT(II) )/(CURNT(II)+sero)  ) 

110  ERM  =  dMAX 1 ( ER 1 , ER2 » ERM ) 

C 

cm  OUTPUT  RECORD  IF  ODLG  IS  EXCEEDED  OR  100  METERS  SINCE  LAST  OUTPUT 
C 

DX  =  CURNT ( 1 )  -  OUT ( 1 ) 

IF <  RI.NE.l.  .AND.  ERM. LT. ODLG  .AND.  DX.LE.ODLLG)  RETURN 
C 

Cm  RECORD  THE  LAST  POINT  TO  BE  UNDER  THE  ERROR  CRITERIA.  IN  CASE 
Cm  THE  FIRST  POINT  AFTER  A  RECORD  EXCEEDS  THE  ERROR  BOUND,  RECORD 
Cm  THAT  POINT  AS  HELL. 

C 

DO  120  11=1, nssa 

IFIRI  .EO.  RII+1 . )  BKSP(II)  =  CURNT(II) 

120  OUT(II)  =  BKSP(II) 

C 

RI  a  RII 

PRMT (11)  a  PRMT(ll)  +  1. 

C 

HRITE(?,«)  (0UT(II),IIal,nss3) 

RETURN 

C 

1000  CONTINUE 
Cm  STOP  INTEGRATION 
2  —  sasJdesadisiSSGOUT.FGR 
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m 


& 


m 


% 

$ 


Sil 


PRNT<12)  *  X 
TSTOP  »  TSL 

PRMT(ll)  «  PRNT(ll)  +  1. 
WRITER*)  (CURNT(II)»I>l»ftf*a) 


PRMT(5)  »  1. 


RETURN 

END 
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C . . . . . 

c 

SUBROUTINE  SSGOUT ( X » Y *  0 » IHLF >  NDIM , PRHT > 
c 

Illicit  R*al*8  (  A-H»  O-Z  )»  Ir>t»s«r*4  (  I-N  ) 

parameter  (nss **9>  z«ro*l.*-10> 

C 

DIMENSION  Y ( 1 ) t  D (1 ) >  PRHT ( 1 ) » BKSP ( nss* ) » OUT ( nsss ) » CURNT ( nss* ) 

C 

includt  '  ivstdMidis : DEGADIS2 . dtc/list ' 
c 

COMMON 

» /? ARM/UO »ZO»ZR»ML»USTAR»K>G» RHOE » RHOA >  DELTA  r  BETA » GAMMAF t CcLOU 

l/STP/STPP . ODLP » ODLLP » STPG » ODLG » ODLLG 

*/ALP/ALPHA»«lNwI 

C 

c 

REAL *8  ML»K 

C 

~m  PARAMETER  OUTPUT 

L 

CM*  FROM  SSG  OUTPUT  TO  MODEL 

Ctll -  - — — - 

CM*  X  DIST 

CM*  PRHT  (7)  Ce 

CM*  T«l)  SZ 

CM*  PRHT  (8)  XV 

ERM  *  0. 

f»r*t(22)  *  *r«t<21) 

C 

IF(PRHT<11)  .NE.  0.)  GO  TO  90 
C 

CM*  STARTUP  FOR  OUTPUT  ROUTINE 
C 


RII  »  -100. /STPG 

RI  *  0. 

CURNT ( 1 ) 

*  X 

CURNT(2) 

=  PRMTU4) 

i 

VC 

CURNT(3) 

*  *p»t<7) 

; 

cc 

CURNT(4) 

*  PRHT( 13) 

! 

pho 

cumt(5) 

*  pp«t(17) 

t 

iim 

cumt(6) 

*  pp»t(16) 

i 

t*** 

eurnt<7) 

*  0.0 

! 

b 

curnt(3) 

*  pp«t(21) 

! 

sz 

curnt(9) 

*  pt2*d#lt.j*(x+^p*t(8)  )Mbeta 

c 

90  CONTINUE 
C 
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Zttt  RECORD  THE  CURRENT  AND  PREVIOUS  RECORDS 

w 

RI  »  RI  +  1. 

C 

DO  100  II=l»ns*s 
100  BKSP(II)  *  CURNT(II) 

CURNT(l)  »  X 

CURNT<2)  *  PRHTU4)  !  *c 

CURNT(3)  *  pr*t(7)  !  cc 

CURNT(4)  *  PRMT(15)  !  rfto 

curnt(5)  *  pr«t<17)  >  Mm 

curnt(6)  *  prat (16)  !  tw 

curnt(7)  *  0*0  !  b 

curnt(8)  *  pr*t<21)  !  sz 

curnt(?)  *  rt2*d«lta*(x+^r»t(3)  )«brta  !  $« 

C 

Cm  STOP  INTEGRATION  WHEN  Cc  <  CcLOW 
C 

IF(PRHT(7) .LT, CcLOW)  60  TO  1000 
C 

C*t*  CHECK  FOR  OUTPUT 
C 

00  110  II*2?nss* 
if(ii.«a.7>  Soto  110 

ESI  *  ABS<  (CURNT(II)-BKSP(II) )/(CURNT(II)+2«ro)  ) 

ER2  *  ABS<  (CURNT<II)-(WT<ri))/(CURWTai)+z«PO)  > 

110  ERH  •  dHAXl<ERl,ER2»ERH) 

C 

cm  OUTPUT  RECORD  IF  DDLS  IS  EXCEEDED  OR  100  METERS  SINCE  LAST  OUTPUT 
C 

DX  *  CURNT(l)  -  0UT(1) 

IF <  RI.NE.l.  .AND*  ERM.LT.0DL3  .AND.  DX.LE.ODLLG)  RETURN 
C 

cut  RECORD  THE  LAST  POINT  TO  BE  UNDER  THE  ERROR  CRITERIA.  IN  CASE 
Cm  THE  FIRST  POINT  AFTER  A  RECORD  EXCEEDS  THE  ERROR  BOUND?  RECORD 
C*«  THAT  POINT  AS  WELL. 

C 

DO  120  II«l»nssi 

IF(RI  ,£Q.  RII+1.)  BKSP(II)  ■  CURNT(II) 

120  OUT(II)  *  BKSP(II) 

C 

RI  *  RII 

PRMT(U)  »  PRMT(ll)  4  1. 

C 

call  ssout(out) 

RETURN 

C 

1000  CONTINUE 
C 

Cm  STOP  INTEGRATION 

C 

2  —  3 vs  t  dssad i s ! SSGOUTSS . F OR 


PRNT<12>  =  X 
PRUT (11)  *  PRMT(ll)  +  1. 
C 

call  ssout(curnt) 

C 

PRNT<3)  »  1. 

C 

RETURN 

END 

*### 


f«*«dtaadi$JSSOOUTSS.FOR 


subroutine  stoutfout) 
c 


Implicit  Rea 1X8  <  A-H>  0-Z  )»  Inteter*4  (  I-N  ) 

dimension  out<9) 
c 

COSMO 

*/coe_ar roe/  m.iw « eat. tee* * eat.  rhoe  *  tas.crk » aas.ee* » 

I  sas.uflrsas.lflfsas.zsersas.naae 
Vcoe.fl/  cflasrclflrcufl 
I/.jW  aleharalehal 
e 

character*3  tas.naee 

c 

data  i*/0/ 
c 

losical  cflaa 
c 
c 

dist  3  out(l) 
sc  *  out(2) 
cc  *  out<3) 
rho  »  out(4) 

Jaaaa  *  out(S) 
tee*  ~  outf£) 
l)  *  out (7) 
sz  3  out(8) 

3  out(9) 
c 

iff .not. cf las)  then 

call  adiabatf-2>ucrwaiaas.lflr*arclflrrrwrsaaaar tt) 
call  adiabatf-ZfUCrwarUs.uflfyarcuflr rrwrsaeaar tt) 
endif 

c 

are  «  fsas_zs*/sz)*Xalehal 
if fare  .a*.  30.)  soto  £00 

w 

ccz  *  cc/exefars) 
iffeez  .It.  clfl)  then 
if(cflas)  then 

«RITE(3»1120)  DISTrscrCcr rhorteeer BtSZrSY 
else 

URITE<8»1125)  DISTrscrCcrrhorSaaaar te**rBrSZ»SY 
endif 

soto  £00 
endif 

are  *  -fdlosfclfl/cc)  +  <sas_zse/sz)**elehal) 
blfl  *  soi't(ara)tss  f  b 

if' ccz  .It.  cufl)  then 
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;a 

.«V'J 

Vfj 

I 


if(cflas)  than 

URITE(8»  1120)  DIST>¥c>Cc>rho*t»ap>B»SZ>SY*bin 

else 

WRITE(8> 1125)  DIST>*c»Cc> rho»*snar teer>B»SZ>SY»blfl 
•ndif 

Soto  600 
endif 

are  *  -(dlos(cufl/ee)  +  (S«»2sp/5z) Walphal ) 
bufl  *  sart( ars)*;*  +  b 
if(cflaa)  than 

URITE<8>1120)  DIST»*c>Cc>rho»teep>B*SZrSY>blfl>bufl 
(1st 

URITE(8»1125)  DIST>¥e»Cc»rho>saee3»te»r»B»SZ»SY»blfl>bufl 
and  If 
c 

600  continue 
ip  =  ip  +  1 
if  dp  .ea«  3)  then 
ip  *  0 

urite<8f 1119) 
endif 
C 
C 

1119  FORMATdH  ) 

1120  FORMAT; 1H  »11< 1X»1PQ9.3»1X) ) 

1125  FORMATdH  ,3<lXf lPQ9.3t IX) f2x,0PF7.4f2:(,lXflPG10.3rlXr 
1  6dX*lPQ9.3,lX)) 

C 

return 

end 


f 

• 

I 

I 

\ 

t 

I 
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noon 
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PSEUDO-STEADY  STATE  SUPERVISOR 
SUBROUTINE  SSSUP(H.aasrti> 


Illicit  R«al*8  (  A-H>  0-Z  )r  InttMrM  (  I-N  ) 


include  ' iwsldeaad i s : 0E8AD IS2 . dec/nolist ' 


COMMON 

4/GEN3/  rada<2.aaxl).astr(2.aaxl).srcdan(2.aaxl)  .srcwc<2.aaxl> » 

3  srcwa(2.eaxl > .srcenth(2.aaxl) 

3/SSCON/  NREC ( aaxnob  *  2 ) » TO ( aaxnob ) » XV ( aaxnob ) 

I/GEN1/  ET(2»id«n>»RlT(2»iaen) 

S/aen2/  d«n(3» iatn) 

9/coa.dP  ro*/  iit.au »  tlas. tea* . das. rhoe » *a*„c*k  > aas-ca* » 

9  aas..ufl»aas_lfl»da*>2t*»da*_naa« 

l/PARM/  UO. ZO » ZR > ML » UST AR .K.G.RHOE.RHOA. DELTA » BETA. GAMMAF.CcLOW 
l/ERROR/SYOEP »ERRQ » SZOER » MTAIO . NTQOO. MTSZO. ERRP . SMXP . 

$  UTSZP » UTSYP , MTBEP » NTDH >  ERRQ» SMXG » ERTDNF » ERTUPF » MTRUH »  UTDH6 

3/coaata/  i stab  . taab  »  aaab  » huai d » i sof 1 » tsurf » ihtf 1 » htco » i utf  1 $ wteo 

9/PARMSC/  RM  >  SZH  > EMAX » RMAX » TSC1 . ALEPH . TEND 

9/STP/  3TP0 , STPP » OBLP » ODLLP . STP8 . ODLG . ODLL  B 

9/PHLA6/  CHECK 1 > CHECK2.AGA IN .CHECX3.CHECK4. CHECKS 

9/ALP/  ALPHA. alahal 

3/*fueoa/  iebifl.dtllay 

3/s*rd_con/  c*»  delrhoain 

l/STOPIT/  TSTOP 

l/CNOBS/  NOBS 


REAL *8  K.ML.L 

LOGICAL  CHECK 1 . CHECK2 .AGAIN. CHECK3 . CHECK4 .CHECKS 
lcaieal  eue.edn 


char act* r*3  sas_naa* 

EXTERNAL  PSS . PSSOUT >  SSG . SSGOUT . OB . OBOUT 
DIMENSION  PRMT(22) »Y(S) .DERY(S) .AUX(S.S) 
DATA  RTOT/O./ 


R  *  AFGEN(RADG.O.O.'RAOG') 

TCI  *  TOOB<R.O.O) 

XEND  >  AFGEN ( RADG » TEND » ' RADG ' ) 
TOF  »  T008( -XEND. TEND) 


DT08  *  (T0F-T01)/FL0AT(NOBS+l) 
sysfdcaadisiSSSUP.FOR 


c 

Cm  RESET  AGAIN 
C 

AGAIN  *  .FALSE. 

C 

TO<I)  *  DT08*float<I-l)  +  T01 
pup  *  .true. 

?dn  »  .true. 

C 

Cm  IF(XEND  .GT.  XIT<TEND»TO(I) ) )  —  IS 

Cm  TRUE  WHEN  THE  SOURCE  WILL  TERMINATE  BEFORE  THE  OBSERVER 

Cm  CAN  REACH  THE  DOWNWIND  EDGE. 

C 

IF<XEND  .GT.  XIT(TEND,TO<I))>  than 
pdn  a  .fjlse. 

TDOWN  -  TEND 
and  if 
c 

cm  IF(XIT(O.OiTO<I) )  .dt.  -R)  —  IS 

cm  TRUE  WHEN  THE  SOURCE  WILL  bedin  after  THE  OBSERVER 

Cm  has  passed  THE  DOWNWIND  EDGE  f  t»0.0 

C 

R  a  AFGEN<RADG»O.Of 'RADS' ) 

IFCtO(i) .le.O.  .and.  XIT(0.0»T0<I)).dt.-R)  then 
pup  *  .false. 

TUP  »  0.0 
andif 
c 

if (pup)  TUP  a  TUPF(T0<I)) 
if (Pdn)  T DOWN  a  TDNF(T0<I)) 

C 

XDOWN  «  XIT(TDOWNiTO<D) 

XUP  a  XIT(TUP»T0(I) ) 

WRlTE(lunlodrll60>  TUP » XUP t TDOWN r XDOWN 
C 

CM*  SET  UP  INTEGRATION  PARAMETERS  FOR  EACH  OBSERVER. 

C 

do  iJk»l>22 
prnt(iJk)  *0. 
enddo 

do  ijk*l»5 

y(iJO  *  0. 

dera(iJk)»  0. 

do  ijkl»l*8 

aux( iJklfiJk)  a  o. 

enddo 

enddo 

2  --  swstdedadisJSSSUP.FOR 


PRNTd)  »  Tiff 
PRHT(2)  »  TDOUN 
PRHT<3>  «  STPO 
PRHT ( 4 )  «  ERRO 

PRNT<5)  ■  dMAXl d . DO  *  < TDOWN-TUP ) /SO . DO ) 

PRHTU)  «  TO(I) 
j>rat(7)  ■  xw 
PRNTd3)»  XDOWN  -  Xlff 
C 

Y(l)  »  0. 

Y(2)  *  szOar  !  Nrata 

c  Y<3>  *  SZOER 

*<3)  a  szOar  !  Crata 

a<4)  >  0. 

j<3)  «  szOtr*H_aasrta  !  Hrata 

C 

DERY(l)  »  WTAIO 
DERY(2)  *  MTQOO 
DERY(3)  -  WTSZO 
DERY ( A )  *  1. 

0ERY13)  »  1. 

C 

NDIN  3  4 

lfdsofl.aa.  0  .and.  ihtfl.na.  0)  ndi»«5 

C 

Cttt  PERFORM  INTEGRATION. 

C 

WRITEdunlodf  1120)  I 

1120  FORHAT(/» '  Entarind  Obsarvar  Intadration  Star  for  Obsarvar  ♦  'r 
113) 

C 

CALL  RK6ST ( PRHT »Y»DERY»NDIM»IHLF>OF» OBOUT » AUX ) 

C 

IF ( IHLF  .GE.  10)  CALL  trar<8»IHLF> 
e 

writadunlod>1125) 

1123  foraatt'  SiOxi 'Obsarvar  Intadration  coarlata...') 
c 
c 

cclav  »  rratd4) 
ec  *  cclasMallas 
uclaw  ■  rrat(13) 
ualav  *  pratd6) 
enthla**rratd7) 
rhola*  *  pratdS) 

call  satdan(wclaa»galav»anthlaw) 
if fisofl.aa.  1)  doto  200 
.Jo  iii»  l*iaan 
if(dtftd>iii)  .dt.  1.)  than 

3  —  3*stdaSidis:SSSUP.F0R 
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ii  *  iii+1 

rhola*  ■  den(3»iii-l) 
teals*  *  dsn<3*iii-l) 

if(ii  .at.  isen  .or.  iii.le.3)  call  trap(2> 
cc  *  cclayXdella* 
if(cc»dt.  rhoa)  than 

urita(lunlod>1126)  ec»  rhoa 

1126  foraat</*'  '»1 0< '****' )»/>'  cc:  '»1p*13.3»'  is  sraatar'» 

1  '  than  rhoa.'  '»lpal3.5»/> '  'tlO(  'XXXX')»/> 

cc  *rhoe 
endif 

rho  3  ccX(rhola*-rhoa)/celay  +  rhoa 
wc  =  ce/rho 

m2  =  den<2»iii-2)/den(3»iii-2) 
ul  *  dan<2»iii-l)/den<3»iii-l> 
slope  3  (mc-w1)/(u2-w1) 

Yc3  daaxl(l.D0>  slopeX(den(l»iii-2)-den(l»iii-l) )+den(l*iii-l) ) 
den(lfiii)  =  Yc 
den<2»iii)  3  cc 
den(3»iii)  3  rho 

if(den<3»iii-2) .na.  den<3»iii-l)>  than 
slope  3  (l./rho-l./dan<3»iii-t))/ 

1  (l./dan<3>iii-2)-l./dan(3»iii-l)> 

den<4»iii)  3  slopaX<dan(4»iii-2)-dan(4»iii-l) )+den(4»iii-l) 

den(4»iii)  3  daaxl(h«aasrta»dan(4>iii) ) 

den<5»iii)  3  slapeX<den<3»iii-2J-den<5riii-l>)+den<3fiii-l) 

den<3»iii)  3  daaxl (3as_teap»den<3»iii) ) 

else 

den(4*iii)  3  den(4»iii-l) 
dan(Sfiii)  *  den(5riii-l> 
endif 

teap  3  dsn(5fiii} 
den(l»ii)  3  2.  !  end-of-record 

c  if<cc.:it.  rhoo)  call  trar<31) 
doto  200 
endif 

enddo 

C 

200  L  3  XDOUN  -  XUP 
B  3  YU) 

AREA  3  BXl 
QSTRO  3  Y(3)/area 


szO  3  (astrOXL/cc  *  alphal/uO/zO)XX(l./alphal)  X  zC 

ratiol*  uOXzO/ALPHAl/  Z0XXAIPHA1  XCc  /B/astrO/L 
ratio  3  ratiolX  srOXXalphal  X  <B  f  sortPi/2.Xs»0ar) 
if ( ratio. le.  1.)  than 

s*0ar  3  (l./(ratiolXszOXXalphal)  -  B)X2./sortPi 

else 

s zO  3  (l./((Bf  sartPi/2.Xs«0er)Xratiol))XX(l./alphal) 

endif 


4  —  sms  fdedadi s  S  SSSUP .  FOR 


C-136 


Epate  *  2.*astrOSLSb 
IF(Cc  .GT.  RHOE)  then 

WRITER lunloa» 1180 )  QSTR0»SZ0>Cc 
call  tra*<30) 
endiY 
C 

COS  SHOW  THE  OPERATOR  WHAT  IS  GOING  ON 
C 

WRITE(lunloa» 1160)  TUP»XUP>TDOWN>XDOWN 

URITEdnnloSt  1170)  AREA*L#B 

WRITE( lunlos» 1180)  QSTRO'SZOtsyOer 

write* lunloa# 1185)  wclas»walaw/pholav>ccla«»t«elay 

upite(lunlo3»ll86)  wc> rho»cote«* 

1160  FORMAT (/» '  TUP:  '»1j»G13.S»'  XUPt  '»1H513.3»'  TDQWNt  '» 

I  lf»Gl3.5i'  XDOWNt  '»1?G13.5) 

1170  FORMAT ( '  AREA:  'flPG13.5f'  LENGTH.*  ',lpG13.5f'  Bt  '»li>G13.5) 
1180  FORMAT ( '  TAKEUP  FLUX?  '»1*G12.3>'  SZOJ  '»U»G12.5» 
t  ‘  sso:  ' >  ipsi2.3) 

1133  formats  wcla«:  '>1m12.5>'  walaa:  '>li»Sl2.3> 

1  '  rhola«:  '  »1m12.3»'  Cclas.*  '»1i»312.5»/> 

1  '  teelavl  '  >1m13.3) 

1136  format* '  we!  '  »1j»312.5> 

1  '  rho.*  '»1J»S12.5»'  Cc:  'tlpsl2.5f'  tern*:  '  >1*312.5) 

C 

CSSS  PREPARE  FOR  PSEUDO-STEADY  STATE  INTEGRATION. 

C 

do  ijk*l>22 
prat(iJk)  *0. 
enddo 

do  ijk=l>5 
y(iJk)  *  0. 
dery(iJk)*  0. 

><o  iJkl=l>8 
atjx(iJkltiJk)  a  o. 
enddo 
enddo 

PRMT(l)  a  XDOUN 

PRMT(2)  »  6.023E23 

PRMT* 3)  »  STPP 

PRMT  <  4 )  a  ERRP 

PRMT (5)  =  SMXP 

PRMT (a)  =  Erate 

PRMT (7)  »  cc  !  —  OUTPUT 

PRMT ( 3 )  *  b  !  —  OUTPUT 

c 

CSSS  PRMT'?)  t  PRMTUO)  ARE  CONSTANTS  FOR  D(SY)  t  D(SZ) 

r 

PRMT(?)  a  CeSsa Pt ( GSZ0/ALPHA1 SGAMMAF ) SG AMMAF/UO 
PRMT < 10)*  ZOSS ALPHASK SUST ARS ALPHA 1 S ALPHA 1 /UO 
PRMT'll)*  NREC ( I » 1 ) 

5  —  smSdessdis:SSSUP.FOR 
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C  PRMT(12)=  DIST  AT  COMPLETION  —  OUTPUT 
PRMT(13)=  TOd) 

c  prat(14)=  »c  !  output 

c  prat (15)=  rho  !  output 

c  prat<16)=  teap  !  output)  not  recorded  if  isofl=l 

c  nrat(17)=  Sanaa  !  output)  not  recorded  if  isofl=l  .or.  ihtfl=0 

prat<18)=  u0*z0/alphal 
prat (19)=  rhoaZktustarlalphal 
prat(20)=  rholss 
prat(21)=  szO 
prat(22)=  szO 
C 

Yd)  =  rhol  3a*p rat  ( 1 8 )  *  ( SZO/zO )  ttalphal  !  rho*ueff*heff 

Y(2)  =  SYOER 

YC3)  =  B  +  sartpi/2.*ss0er 
«(4)  =  0.  !  added  heat 

C 

DERYd)  =  WTSZP 
DERY(2)  =  MTSYP 
DERY(3)  =  MTBEP 
dery(4)  =  WTDH 

r 

NDIM  =  4 
C 

WRITE(lunlod» 1130) 

1130  FORMAT ( '  Entering  Integration  Step  —  B  >  0.  ') 

C 

C*W  PERFORM  INTEGRATION 

C 

CALL  RKGST ( PRMT » Y  >  DERY , ND I M  > IHLF  >  PSS » PSSOUT t AUX ) 

C 

IF < IHLF  .GE.  10)  CALL  trap(9,IHLF) 

C 

NREC(I»1)  =  INT (PRMT( 11) ) 

URITE(lunloSfllOO)  NREC(Id),TO(I) 

1100  FORMAT (3X> 'NUMBER  OF  RECORDS  IN  PSS  =  'I10»'  FOR  T0='lrdl3.5) 

C 

IF(AGAIN)  GO  TO  119 
C 

Cm  GAUSIAN  COMPLETION  OF  THE  INTEGRATION 
C 

cm  PSSOUT  FORCES  THE  ABOVE  INTEGRATION  TO  FINISH  WHEN  B<0  FOR  THE 
Cm  FIRST  TIME.  THE  STEP  BEFORE  THIS  OCCURS  IS  RECORDED  ON  UNIT  7. 

Cm  THE  STEP  WHEN  B  GOES  NEGATIVE  IS  CURRENTLY  IN  Y. 

C 

cm  THE  CALCULATION  METHOD  CHANGES  THE  CURRENT  VALUE  OF  SY  TO  A  VALUE 
Cm  CALCULATED  AS  IF  8EFF=sartPitSY/2.  RETAINING  THE  LAST  VALUE  OF  Cc  IN  THE 
Cm  MATERIAL  BALANCE. 

C 

heat  3  y<4) 
rhclay  =  prat(20) 

6  —  sssIdeaadisJSSSUP.FOR 


Cc  =  PRNT(7> 
rhouh  »  Y<1) 

52  *  <  rhouh/ rhola*/prat< 18)  )**(l./alphal)  *  rO 
SYT  *  £  rata* ALPHA 1  It  <  ZO/SZ ) ** ALPHA/UO/SZ/Cc/SQRTP I 
C 

XT  »  PRNTU2) 

XV<I)  «  ( SYT/RT2/DEL TA ) » <1 . /BETA )  -  XT 
C 

C*W  SET  UP  INTEGRATION  FOR  THE  GAUSSIAN  DISPERSION  PHASE. 
C 

do  iJkal»22 
pra t(iJk)  a<), 
enddo 

do  ljkai;5 
•j<iJk)  »  o. 
dery<iJk)a  0. 
do  Uklai,8 

3ix;(iJkl>iJk)  3  o. 

enddo 

enddo 

c 

PRMT(l)  a  XT 

PRNT(2)  »  6.023E23 

PRMT(3)  *  STPG 

PRMT(4)  a  ERRQ 

PRHT(S)  »  SNXG 

PRNT(A)  a  Erato 

PRMT(7)  ■  Cc  !  —  OUTPUT 

PRHT(S)  =  XV(I) 

PRMT(?)  »  TO<I) 

C  PRNT(IO)*  * BLANK* 

PRMTUl)a  NREC(I>2) 

C  PRMTU2)*  BIST  AT  COMPLETION  —  OUTPUT 
c  prat(13)a  'blank* 

c  prate  14)*  *c  !  output 

c  prate  15)*  rho  !  output 

c  prate 16)«  trap  !  output 

c  prate 17>a  uui  {  output 

prate 13)»  uOtzO/alphal 
prat( l?)a  rhoalktustartalPhal 
prat (20) *  rhulaa 
prat(21)a  52 
prat(22)*  $2 
C 

Y<  1  ;•  »  rhouh 
Y(2)  *  heat 
C 

OERY(l)  *  WTRUH 

dor«<2)  »  UTDHG 

C 

HDIN  »  2 
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C 

WRITE(lunloS»1140) 

1140  FORMAT ( '  EntarinS  Gaussian  Stas#  of  Integration 
C 

Cm  PERFORM  INTEGRATION 
C 

CALL  RKGST ( PRMT * Y » DERY » ND IM  » IHLF » SSG  » SSGOUT » AUX ) 
C 

IF<IHLF  .GE.  10)  CALL  traeUO.IHLF) 

C 

NREC(I»2)  *  INT(PRNT(11) ) 

RTOT  a  RTOT  f  FL0AT<NR£C<I»1)  *  NRECCI.2)) 
HRITEdunloS. 1110)  RTOT. I 

111C  FORMAT C3X. 'TOTAL  NUMBER  OF  RECORDS  a  ',1*G13.4»' 
$'  DBS  #  '  .13) 

C 

IF (RTOT  .GT.  120000.)  CALL  trae(ll) 

C 

11?  CONTINUE 
120  CONTINUE 

C 

RETURN 

END 

***♦ 


3  —  3* lidasadi s : SSSUP . FOR 


THROUGH'. 


SUBROUTINE  STRT2 ( OPNRUP » H_aas  r te ) 


Illicit  Real >8  (  A-Hf  0-Z  )»  Inteser*4  (  1-N  > 
include  'sustdusadislDEGADISZ.dec' 

COMMON 

3/GEN3/  radd(2»eaxl) »a*tr(2>Mxl)**rcden(2»eaxl)»sreuc(2»eaxl)» 

*  srcMa(2»aaxl) »srctnth(2»eaxl) 

3/TITL/  TITLE 

i/GENl/  ET<2>iitn)fRlT(2 risen) 

3/0EN2/  CEN<3risen) 

l/ITI/  T! fTINPfTSRCfTOBSfTSRT 

3/ERR0R/SY0ER f ERRO r SZOER » HTAIOf UTQOO r UTSZQ  r ERRP r SMXP » 

*  WTSZP r WTSYP r WTBEP fWTBHf ERRS r SMXG r ERTDNF r ERTUPF r MTRUH r MTDHG 

I /PARM/  UO  f  ZO  *  ZR f ML f USTAR i K f 6 r RHOE » RHOA  r DELTA f BETA » GAMMAF t CcLOW 
3 /coa.se roe/  eas.au r sas. tear r sas. rhoe  r sas.eek » sas.eee r 
3  sas.uf 1 rsas.lfl rsas_zserdas_naae 

t/coaata/  istabr taabreaabrhuaidr isof 1 >  tsurf » ihtf 1 FhtcoF iwtf 1 f wteo 

l/PARMSC/  RM  f  SZM  f  EMAX  f  RMAX  >  TSC1 f  ALEPH » TEND 

3/PHLAO/  CHECK 1 r CHECK2 f  AGAIN*  CHECKS f  CHECK4  f CHECKS 

3/coa.sisx/  sisx.coeff FsiSx.eowFSisx.ain.distFsisx.flas 

3/NEND/  POUNDNf POUND 

l/ALP/  AI.PUAf  alehal 

l/?hicoa/  iehiflrdellau 

l/serd.ccn/  ctr  deimoain 

3 /COM. SURF/  HTCUT 

character*80  TITLEC4) 

character 34  pound 
character*24  TINPfTSRCfTOBSfTSRT 
character #3  sas.naae 

REALtS  KfML 

LOGICAL  CHECK 1 fCKECK2fAGAINfCHECK3fCHECK4fCHECK5 

character*40  OPNRUP 

OPEN ( UN IT*9r  NAME*OPNRUP  f  TYPE* ' OLD ' ) 

00  90  I  *  1f4 
90  READ<9f1000)  TITLE(I) 

1000  FORMAT (A80) 

REA0<9f*)  NP 
DO  100  1*1 fNP 

100  READ ( 9 f * )  ET(IfI) fET(2fI) fR1T(2fI) 


t 


s vstdeSadis  2STRT2 . FOR 
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00  110  I«1*NP 
110  RlT(lfl)  »  ET ( 1 » I ) 

I  »  NP  +  1 
ET(1»I)  *  POUNDN 

ET(2»I)  *  POUNDN 

RlTdd)  *  POUNDN 
R1T(2»I)  *  POUNDN 
c 

READ<9>«)  NP 
DO  220  I*1*NP 

220  READ<9f«)  DEN(1»I)»D£N(2»I) *dan<3*I> *dtn<4fi) *d«n<3*i) 
dtnd*n*+l)  *  2. 

c 

R£AD(9*t>  NP 
DO  300  >1  »NP 

READ<9*»)  radsdd) ?rad*(2i I) *#str<2*I) >srcden<2»I) »srcwe(2»i)» 

1  *pcv*<2>i) »«rc«nth(2»i) 

astrd»I)  *  radsdd) 

srcd«nd*I)  >  radsdd) 

srewcdd)  «  radsdd) 

srcwadd)  a  radsdd) 

sreenthdd)  >  radsdd) 

300  continue 
I  a  np  +  i 
radsdd)  a  POUNDN 
radd(2»I)  a  POUNDN 
astrd#I)  a  POUNDN 
astr<2.»I)  *  POUNDN 
sred«n(l»I)  *  POUNDN 
;rcd»n(2d)  »  POUNDN 
sreuedd)  *  POUNDN 
srcuc(2»I)  »  POUNDN 
srcwadd)  =  POUNDN 
srcwadd)  ■  POUNDN 
sreenthdd)  a  POUNDN 
sreenthdd)  *  POUNDN 

r 

w 

READ(?d010)  TINPiTSRC 
READ(9d010)  tobtrTSRT 

c 

READ<?»*)  U0rZ0dR*HL»USTAR 
read<9,«)  K.G*RHOE*RHOA* DELTA 
read<9*t)  BET  A t GAHHAF  t CcLOW 
c 

READ(9*t)  RH > SZM t EfIAX * RHAX » TSC 1 
read(9f»)  ALEPH*TEND 
c 

READ ( 9 * * )  CHECK 1 > CHECK2 » AGAIN* CHECK3 > CHECK 4 > CHECK5 
c 

READ(9*»)  ALPHA 
signal  *  aleha  t  1. 

2  —  SM*desadisJSTRT2.F0R 


read<9?1020)  litjini 
rtad<9>*)  ea*_awr*ai_te*e»«af_rhoe 
re»d<9»*)  «M.CPfcr*M.CPP 
read(9»*>  aas.uf 1 f aat.lf 1 » s«t_zse 
c 

read(9>#)  istsb 
rasd(9ft)  tMbrMabihuaid 
read(9»*>  isofl»tsupf 
read<9>*)  ihtfl>htco 
r«ad(9»X)  iutfliutco 
c 

read  ( ?  1 1 )  s idx.coef f  * *idx->ow » *i dx_ein_dist 

c 

read(9*»)  iehiflidellaw 
c 

H_aaarte  *  0. 

iffisofl.ea.  0)  read(9rt)  H_*a»rt# 

C 

READ(9f<)  HTCUT#  d>  delrhoein 
c 

1019  forut(2(a24»lx)) 

1020  forest < *3) 

C 

CLQSE(UNIT*9) 

C 

RETURN 

END 

**«# 


7 
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SUBROUTINE  STRT2  ( OPNRUP  *  H_aas  r ta ) 

Illicit  Raal*8  (  A-H*  0-Z  )»  IntadarM  (  I-N  ) 
INCLUDE  '  svsfdadadi > 1  DE0ADIS2 . DEC/LIST ' 


BLOCK  COMMON 
COMMON 

4/TITL/  TITLE 
S/GEH2/  D£N<S*IGEN) 
l/ITI/  T1 * TINP * TSRC * TOBS 

S/PARM/  UO * ZO * ZR * ML * UST AR * K, G*RHOE*RHOA» DELTA » BETA *GAMMAF*CcLOU 
1/coa.s*/  ESS * SLEN *  SH ID  * OUTCc  * OUTSZ * OUTB *  OUTL  * sue 1 » swal * sen 1  *  s  rhl 
S/PHLA6/  CHECK 1 1 CHECK2 * AGAIN* CHECK3 » CHECK4 . CHECKS 
*/coa_aprop/  rhoa  *  sa*_cpk  >  $as_cpp  » 

%  das_ufl*aaa_lfl»da*-2SP*da*_naaa 

f /coaata/  i  stab * taab  *  paab  *  huaid ► isof  1 » tsurf  *  ihtf  1  *  htco  >  i  utf  1  *  utco 
«/NEND/  POUNDN* POUND 
l/ALP/  ALPHA* alphal 
1/phicoa/  iphifl*dalla* 

*/»prd_con/  ca*  dalrhoain 
$/COM_SURF/  HTCUT 
C 

charactar*80  TITLE(4) 
charactar*24  TSRC* TINP* TOBS 
charactar*40  OPNRUP 
character*3  daajiaaa 
charactarM  pound 
C 

REAL *8  K*ML 

LOGICAL  CHECK 1 • CHECK2 *  AGAIN  * CHECK3 *  CHECK4  *  CHECKS 

C 

OPEN <  UNI T  *9  *  NAME *0PNRUP  *  TYPE* ' OLD ' ) 

C 

DO  90  I  «  1*4 
90  READ<9*1000>  TITLE! I) 

1000  FORMAT (A80) 

C 

rtad(9*«)  pip 
do  100  i*l*np 

100  p«ad<9*t)  duaaw 1  * duaau 2 > duaaw3 
e 

READ(9»*)  NP 
DO  120  1*1 *NP 

120  R£AD<9*X>  DEN(l*I)*D£N<2*I)*dan(3*i)*dan<4*i)*dan(3*i) 

I  *  NP  +  1 


—  sustdadadis 1STRT2SS .FOR 


DEN(1»I)  «  2» 
c 

p«ad(9>*)  nr 
do  140  i-l*n* 

140  read(?f»)  duaaylfduaay2*duaav3»duaay4»dua2idua6>dua7 
C 

r*ad(9»1100)  tin*»tsc 
p*ad(9»ll00)  tob*»t*rt 
1100  foraat<a24flx»a24) 
c 

READ(9r»)  UO»ZO»ZR,KL*USTAR 
R»ad(9><)  K»G»RH0EiRHQA» DELTA 
rcad(9>«)  BET  A  t GAHMAF > CclQW 

c 

rsad(9»*)  duaayl 
r«ad(9>lc)  duaaul 

c 

READ ( 9 » * )  CHECK1 » CHECK2 » AGAIN » CHECK3 » CHECK 4 » CHECKS 
c 

READ<9»«)  ALPHA 
alPhal  »  al*ha  f  1. 


c 


c 


c 

e 


C 

c 


C 


read (9f  1200)  *as-naaa 
p«ad<9»*)  das_aw»«as.taa*F*as.rhoc 
read<9»«)  jtf*-c*k»das,.c>>* 
p«ad(9r»  aa*_ufl»da«_Ifl»aa*-2iF 

p«ad<9»«)  istab 
r«ad(9><)  taabfpaabihuaid 
r»ad(9»*)  isofl»t*urf 
pfad(9»«)  ihtflihtco 
pead<9»*)  iutflvutco 

r»ad(?»*>  duaanl 

READ ( 9 > * )  ESS»SL£N>SWID 
p«ad(9»*>  OUTCcfOUTSZfOUTBfOUTL 
r»ad(9?«)  sweltswalFftnlFSPhl 

r«ad(9*»)  iahifl'dollay 

h_aa*Pta  »  0. 

iffisofl.aa.  0)  Ptad(9»*>  H_aa»pt# 
READ(9f»)  HTCUTi  ct»  dtlPhoain 


CLOSE (UNIT-9) 
RETURN 

1200  fopaat(a3) 

END 

♦♦♦♦ 


2  --  s«s*dadadi*JSTRT2SS.F0R 
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SUBROUTINE  STRT3(0PMRUP> 

C 

Illicit  ftaalM  (  A-Ni  0-Z  >»  Inted*r*4  (  I-N  ) 
include  ' swsSdeead.*:0CGAdIS3.d*c/list' 

BLOCK  COMMON 
COMMON 

f/SSCON/  NR£C(a«xrtod»2}»T0<a*Knob>»XV(a*xnod) 

I/8EN2/  OEN(Sftacn) 

S/PARH/  UOfZO*ZR»HL>U8TAR»K>6fRHOE»RWOA»OCLTA>BETAi6AHHAF>CcLQW 
9/co«.<f» rep/  m ..mu  uutW’Mi. rhoc » ut.crk » sas .ena » 

l/ITI/  Tt>TINP»T3RC#TQtS*T3RT 

%/ caMtt/  i stator  taato  t Mtbi huaid » isof  1 » tsurf » ihtf  1  >htco>  iutf  1  rutco 
t/PARHSC/  RNfSZNfENAXrRHAXf TSC1»AL£PH»TEND 
B/PHLA8/  CHECK1  r CHECX2 » A8AINtCHECK3r CHECK 4 r CHECKS 
l/caa-inx/  «is>:_cotff  »siax_aourfi*x_*in..distrsisx_flas 
S/NEND/  POUNDN* POUND 
I/ALP/  ALPHA ralahal 
J/CNOBS/  NOBS 
C 

charactar*3  sas.naaa 
charact#r*40  QPNRUP 
charactar*24  TINP,TSRC»TOBS»TSRT 

C 

REALMS  K»ML 

LOGICAL  CHECK 1 » CHECX2 > AGAIN* CHECK3 1 CHECK 4 1 CHECKS 
C 

OPEN  <  UNIT-9 » NAME -OPNRUP » TYPE- ' OLD ' ) 

C 

READ<9*«)  NOBS 
DO  125  I-lrNOBS 

123  READ(9f*>  MREC(I»1)»NREC(I»2)»T0(I)»XV(I) 

m 

W 

READ<?r*>  Nats 
DO  140  I*l*Nats 

140  READ(?>t)  dan(l»i)rden(2»i)rdan<3»i)»dtn(4»i)*den<5»i> 
dandinatsfl)  *  2. 
c 

READ<?*«)  U0»Z0*ZR*NL*USTAR 
raad<?**>  K*G*RHOE*RHOA> DELTA 
rsad<?»*)  BET  A  » 6AMMAF  > CcLOW 

c 

READ(9»1010)  TINPrTSRC 
ptad(9f 1010)  T0BS»TSRT 
1010  fcraatC2(a24»lx)> 

1  —  wsld#Sadis:STRT3.FQR 
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REAB<?»*>  RH>SZM»EMAX*RHAX,TSC1 
read(?»*)  ALEPH»TEND 
c 

read(?>1020)  <».niM 
rtad(?>«)  Sti.H t lis.tiv i lis.rhoi 
read(?»*>  aaa_cHi*da*_ej»p 
read<?>*>  aas_ufl»aa*-lfl>aa*-zsp 
read<?>t)  is tab 
read<?>*>  ta*b»piab»hu*id 
read(9»*>  isofl»tsurf 
read<?><)  ihtflihtco 
read<?>»)  iutfl >wtco 

read  ( 9 *  * )  s  iasj.eoef f  t  si ax-Pow  »  a iax_ain_dist 
1020  foraat(a3) 
e 

READ ( 9 » * >  CHECK 1 » CHECK2 » AGAIN  f  CHECK3 » CHECK4 1 CHECKS 
R£AD(9'«)  ALPHA 
al.»hal  *  alpha  +  1. 

C 

CLOSE (UNIT*?) 

C 

RETURN 

END 

♦*#* 


*«s*deaadi$5STRT3.FOR 
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C  Surface  effects 
C 

SUBROUTINE  Surface(t#ar*heiaht* rho*aole*cr*watrte>art8) 

C 

Illicit  Real*8  (  A-H*  0-Z  )»  Inteaer*4  (  I-N  ) 

include  'systdeSadislDEGADlSl.dec' 
c 
C 

COMMON 

9/P ARM/  UO » ZO * ZR , ML  *  USTAR  >  K  *  G * RHOE * RHOA * DELTA* BETA  *  GAMNAF *  CcLOU 
l/coaata/  istab*taabrpaab*huaid*isofl*tsurf *ihtfl*htco*iutfl*wtco 
t/ALP/  ALPHA* alpha i 
l/rhicoa/  iphiflrdellay 
t/COM-SURF/  HTCUT 
C 
c 

REALT8  HL>K 
REAL *8  L»assrte*aole 
C 

vapor_p( t::xx)  *  6. 0298#- 3*  exp(3407.  t(l./273.15-  l./txxx)) 
c 
c 
c 

watrte  »  0. 
art*  *  0. 

if(isofl.eo.l  .or.  ihtfl. eo.O)  raturn 
if (height. le.  htcut)  raturn 
delta. t  »  tsurf  -  teap 
if(delta_t  .It.  0.)  raturn 
top.val  *  uO  t  ( heisht/cO ) XXalPha 
u 10  s  u0*(10./s0)t*3lpha 

prod.nat  *  ( ( rho/aole)f*2  X  abs(dalta.t) )  tt  0.333333 
iffihtfl  .ea.  1)  than  !  local  correlation 

hn  *  18.  *  rrod_nat 
hf  *  0. 

if (tor.vel  .na.O.)  hf  *  1.22  *  rhotcr  *  ustar«2/tor_vel 
c  hf  *  1.22  *  rhutcp  t  (u'star/ul0)«2ttor_vel 

ho  *  daa>:l(hn*hf ) 

else  if (ihtfl  .ao.  2)  than  !  LLNL  corralation 

ho  *  iitcot  rho<  cp 

elsa  if (ihtfl  .ao.  3)  than  !  Colenbrandar's  aethod 

av_ta»p«  (tsurf  +  taap)/2. 
hn  *  89. *(dalta_t/av_taap»*2)XX. 33333 
hf  -  1,22  *  rhoXcp  *  ustar*X2/ulO 
ho  *  daa;cl(hn*hf ) 

elsa 

ho  a  htco  !  ihtfl »- 1 

end  if 

arte  a  ho  *  dalta.t 
1  —  systdeaedisJSURFACE.FOR 


1  wn  vm*  nr  ■  ip  '»qi  ■  m  in  *w’\u  ~rw 


»“»■  H  »  "n  viviu  rp  m  i  im'i 


*  w  XW  BH 


’w*WT^T^r^v*jrw*i  j  n.'»vfun;  «w>i»ir 
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if(arte  .It.  0.)  then 

write<6.8000)  arte»ho*delta_t 
8000  f0PMt('  SURFACE?  ht  <  0.0?  '  >ledl3.5»2x>  'ho: 

1  ls»sl3.5i/» '  deita_t:  #ilMl3.S) 

call  trae<4) 
endif 

watrte  *  0. 

if (iwtfl  .m.  0)  return 

fo  *  wteo 

if (iwtfl  .at.  0)  than 
fn  *  9.?e-3  *  rrod^nat 
ff  -  20.7  *  ho  /cp  /aole 
fo  *  deaxl(fn»ff) 
endif 

watrte  *  fo/eaeto  *  (vspor~p<tsurf)  -  vgpor-p(tnp) ) 


c 


***# 


return 

and 


I 


—  s vs tdeaad i s • SURF ACE . FOR 


FUNCTION  TO  RETURN  SZO  CALCULATES  over  the  sourct  without 
a  blanket  present  underneath 


NOTE:  Uses  the  integration  package  RK6ST  and  cannot 

be  used  with  an*  other  routine  without  a  local  copw 
of  RK8ST. 

subroutine  SZF<Q»L’SZrccla*>wclax»rholaw) 

Implicit  Real*8  (  A-H»  0-Z  )»  Inteser*4  (  I-N  ) 
external  szlccal>szloco 
REALT8  L 

include  ' sws$deaadis : 0E8A0IS1 . dec ' 

COMMON 

l/szf c/  szstpO  >  sze  r  r  >  szstpax  t szszO 
dimension  Y<2) .0(2) .PRMTU7)  taux<8»2> 


prmt(l)  3  0. 
prat<2)  3  L 
r»rat<3)  3  szstpO 
prat<4)  3  szerr 
prmt<3)  3  szstpmx 
prmtd)  3  0 

Y(l)  3  szszO  !  rho*tdel*uO*zO/(l.talpha)*(sz/zO)«(l.+alpha) 
ndia  3  1 

call  rksst(prmt»w»d»ndim»ihlf .szlocal.szloco.aux) 

ifdhlf.se.  10)  call  trap(3»ihlf) 

cclas  *  pratd3) 
welaw  3  prmt(14) 
rholav  3  prat (15) 
cc  ~  prmtdA) 
sz  3  prat(17) 

RETURN 

END 


•wstdesadisSSZF .FOR 
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c 

c 

subroutine  szloc3l<x***d*prat> 


Iaelicit  Real*8  <  A-H>  0-Z  )>  Inteder*4  (  I -N  > 

diaension  y(l)»d<l)'Prat<l) 
c 

coaaon 

* /> a re/  u0*z0>zr>el*ust3r*k*3> r hoe » r hoe 'delta* beta* aaaaaf * ce 1 ow 
•/ale/  aleha*alehal 
•/phicca/  iphifl'dellas 
c 

real*8  nl  >k 

c 

integer  rhouhlas/l/ 
c 

0  3  prat(6) 

ucla*  *  Q*x/Y( rhouhlay) 
c 

call  adisbatdfuclay'ualay'yc'ya'cclay* rholay*wa*enth*teap) 
cc  *  celay*dellay 

call  adiabat<0'UC'ua'yC'ya'CC'rhO'UB'enthf teae)  !  centerline 

c 

uheff  3  Y<rhouhlay)/rholay/deilay 
c 

sz  3  (  uhef f ZuO/zO*( alehal )  )»(1  ,/alehal)  *  zO 
heff  *  aaaaaftsz/alphal 
ristar  *  rif(rho»heff ) 

Phi  *  phif ( ristar*0. ) 
wel  *  della*  *  k*ustar*alPhal/Phi 
D(rhouhlay)  *  welJrhoa  +  Q 
c 

r>r mt(8)  3  eclay 
prat (9)  3  wclay 
prnt(10)3  rhol3* 
ppat(ll)3  cc 
prat(12)  *  sz 
c 

return 

end 

c 

c 

c 

subroutine  szloco<x>y*  deryiihlf >ndia*  prat) 


laelicit  RealtS  (  A-H*  0-Z  )*  Inteder*4  (  I-N  ) 
diaension  ;<(l)*s(l)'  dery(l)*  prat(l) 

2  —  sysfdesadis JSZF .FOR 


prat(13)  =  j»rat(8) 
prat<14)  *  prat<?) 
prat<15)  *  prat<10) 
prit<14)  »  prat<ll) 
prat<17)  »  prat<12) 
return 
end 

*##* 
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c 

c 

c 

c 

c 

c 

c 

c 

e 

c 

c 

c 

e 

e 

e 

c 

c 

c 

c 

c 


subroutine  tp rop ( i f 1 ? wc » wa ? entha lpy ? sc ? y  a > wa ? teap » r ho ? cp ) 

subroutine  to  return! 

sole  fractions  <y's) 

Molecular  weisht  <wa> 
tearerature  (teapC*3K) 
density  < rhoC*3kS/a*S3) 
heat  capacity  <cpC*3JAS/K) 

for  a  sixture  froe! 

Mass  fractions  (u's) 

enthalpy  <J/kS)  for  ifl.ne.O 

adiabatic  aixins  of!  enitted  sas  9  sas.teap 

entrained  aabient  hue id  air  9  taab 
entrained  water  froe  surface  8  tsurf 
for  ifl.ea.O  calculate  and  return 

adiabatic  lookup  CALL  ADIABAT 

for  isofl.ea.l  .or.  ihtfl.ea.O.and.ifl.ne.l 


Iaplicit  Realt8  (  A-H»  0-Z  )?  InteSer*4  (  I-H  ) 

include  ' sysSdrjdadis.'DEGADISl .dec' 
c 

paraaeter  (tf rac*0.&18?  tfracl*l.-tfrae? 

1  rcrit=0.0003»  acrit*l.»  sero*l.e-20) 

c 

COMMOn 

4/GEN2/  DEN<3» isen) 

1/com.sp  r op/  ias.au ? sas. leap > sas. rhoe  ?  sas.crk ?  sss.cpp » 

*  3as..uf  1  ? sas.lf  1  > das.zsp  ? sas-naae 

i/coaata/  i stab?  taab ? r sab  >  huai d ? isof 1 ?  tsurf ? ihtf 1 » htco ? iwtf 1 ? wtco 
character *3  Sas_naae 

ttt  data  for  3ir/uater  sys 

c 

data  waa/28.96/ 
data  waw/13./ 
data  rho.water/1000./ 
data  cpo/1.0063e3/ 
data  cpw/1863./ 
data  dhvap/2.3023ed/ 
data  dhfus/0.33e6/ 
c 

losieal  rev 
c 
c 

vapor.p(t;:;«s)  *  i.0293e-3*  e>;p<5407,  KU./273.13-  l./txxx)) 


!  Molecular  weisht  of  air 
!  Molecular  weisht  of  water 
!  liauid  water  density  C*3  ks/s*X3 
!  heat  capacity  of  air  C*3JAs/K 
!  heat  capacity  of  water  varorC*3JAs/K 
! latent  heat  uf  V3P  C*3J/ks  water 
(latent  heat  of  fus  C*3J/ks  water 
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S3t.hua(p_tot»;»_vp)  «  0.622*  p.vp/  (p.tot-  p.vp)  !  ks  w/kd  BOA 
ropw_air(p_tot*huaxx)  = 

1  (.00283+  .00436*huaxx)/P-tot/(l .+huaxx)  «  a**3/kd  /K 

c 
c 

MW  »  1.-WC-W3 

wa  a  1 . / ( uc/3as_aw  +  ua/waa  +  ww/waw) 

»e  >  ua/3ic_aw  *wc 
aa  >  ua/waa  *wa 

c 

c 

if(isofl»ea.  1)  than 

c3l 1  adi abat ( 1 r wc  r ua » ac » wa  >  cc » rho  » wa»  enthalpy » tea? ) 

return  !  inter?  density  frua  wc 

endif 


if(ifl.ea.  0) 

1  enthalpy  a  uc*cpc(das.teap)*(das_teap  -  tea b) 

1  +  (ww  -  wa*huaid)$cpw*(tsurf  -  taab) 

c  1  +  w3*(l.+huaid)*cpa*(taab  -  taab)  !  TR>taab 


if(ifl.eo.  1  .and.  ihtfl.ea.O)  than 

call  3diab3t(l»wcfwa»yCFya»cc»rho»ua»enth3lpyfteap) 
return  !  inters  dancita  froa  wc 

andif 
c 

!  c 

rev  a  ,f3is*, 

100  continue 

tain  a  dainl(aas_t*aef tsurf ) 
tainO  a  tain 
tna;:  a  daaxHtsurf*  taab) 
t»a:;0  "  taax 
tan?  s  (tain+taa>:)/2. 

do  300  J»l?33 
sues*  a  tnthaKwCfwefteaa) 
dif  »  enthalpy  -  duecs 

sua  a  (abf(enthalpy)  +  abs(cuacs) )/2.  +  zero 
if 'absCdif )/sua.le. rcrit  .or.  abs(dif).le.acrit)  aoto  400 
c 

if (dif. It.  0.)  than 

if(rav)  taax  *  teas* 
if(.not.rev)  tain  »  tea* 
tea*  »  tain  +  (taax-tain)  *  tfrac 

else 

if (rev)  tain  »  tea? 
if ( .not. rav)  taax  a  teap 
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tear  »  tain  +'  (taax- tain)  *  tfracl 

endif 

c 

300  continue 

rev  s  .not* rev 
if (rev)  soto  100 

write(lunlos»S050)  wc>wa» enthalpy 
3030  foreatr  TPR0P?  wc!  ' »1ps12.3>1xi 

1  'we:  'fli»<12.3rlXf 'enthalpy:  'rl*il2.5> 

clow  ■  enthel(ue>we»tainO) 

if (enthalpy.lt.  flow)  then  !  catch  out  of  bounds  nuabers 
tea*  •  tainO 
enthalpy  *  elow 
Soto  400 
endif 

•low  3  enthal(wc>wa»taaxO) 
if (enthalpy. St.  flow)  then 
tea*  3  taexO 
enthalpy  *  elow 
Soto  400 
endif 
c 

C3ll  tra*<24) 
c 
c 

400  continue  !  density  calculation 

vp  *  va*or_*(tea*) 

sat  3  dainl(  sat_hua(*aab*v*) »  huaid) 

rho  *  l./(t*a**ro*w_air(*aabfset)twat(l.tsat) 

1  4-  wcttea*/sas_tea*/sas.rhoe  +  ( uw-wa*sat ) / rho.uate r ) 

c 

tain  «  tea*  +  10. 

if (tain  .St.  taexO)  tain  »  tea*  -  10. 
if(tain  .It.  tainO)  tain  >  tear  +  .1 
c 

taax  «  enthal(wc»wa*tain) 

cp  *  (enthalpy  -  taax)/ (tea*  -  tain) 

if(c*  .It.  c*s)  c*  ■  era  !  noainal  value  of  air 

c 

return 

end 

c 

c 

function  c*c(tea*) 


laplicit  Real*8  (  A-Ht  0-Z  )t  Intesert4  (  I-N  ) 
coaaon 

* /coa.s*  r op/  Sas.aw  * sas. tea*  * sat. rhoe » sas.cpk » sas.cpr  » 
>  sas.uf 1 > sas_ 1 f 1 > sau.es*  < sas.naae 

3  —  tvsIdesadisiTPROP.FOR 


data  con/3. 33*4/ 
c 

char act or *3  3as_naae 
e 

cs»c  *  con 

if (teap  .na.  aas.teep)  than 
crc  «  con  f  !<s.crkl 

1  ( teap**aas_cpp  -  aas>teapttaas_cpp)/(teep-  aas_teap) 
andif 

crc  *  cpc/das.aw 

return 

and 

c 

c 

function  enthal(uc> war teap)  !  used  be  TPROP 


Implicit  Realtt  <  A-H,  0-Z  )»  InteaerM  (  I-N  ) 


parameter  (delta310.) 
c 


common 

* / com_ar rop/  das_aw  * iat. temp » aas_  rhoa * aas.cpk  > aas-cpp » 
t  aas_ufl.sa5_lf  1  .dai-zsPi-Ja*  .naaa 

t/eoaata/  ist3b>tamb»P3ab>huaid»isofl>tsurf>ihtfl»htco»iwtfl>utco 


c 

c 


c 

c 


c 


chara cter*3  da s_naaa 


data  cpa/1006.3/ 
data  cpw/1865./ 
data  dhvap/2 . 3023e6/ 
data  dhfus/0.33e6/ 


!  heat  capacity  of  air  C33J/ks/K 
’  heat  capacity  of  water  vaPorC3JJ/ka/K 
! latent  heat  of  vap  OlJ/ka  water 
! latent  heat  of  fus  C*]J/ka  water 


ww  »  l.-wa-we 

vp  »  6.02?8e-3*  exp<3407.  «<1./273.13-  i./teep)) 
sat  *  0.622  t  vp/  (psab  -  vp)  !  ka  w/ka  BDA 
wustar  *  wa  *  sat 

dh  *  dhvap 
frsc  3  0. 

if (temp  .It.  273.13)  free  *  dainl(  (273.15B0-teap)/delta»l.D0) 

dh  *  dhvap  ♦  dhfus*frac 

if(wa  .ea.  0.)  aoto  1000 

cloud-hua  3  wu/ua 

if (cloud-hum. le.  sat)  dh  3  0.0 


c 

1000  enthal  3  wc*cpc( temp )*< temp  -  taab) 

1  -  dmaxlUwu-  wwst-jr)  »0.D0)tdh 

1  +  (ww-  wa*humid)*cpw*(temp  -  taab) 
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c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

e 

c 

c 

c 

c 

c 

e 

c 

c 

c 

c 

c 

e 

c 

c 

c 

c 


1  +  wa*(l.+huaid)*cra*( tear  -  taab)  !  TR*taab 

rtturn 

and 


subroutine  adiabat(ifl>wcma»yc»ya*ec>rho»ya»enthalry»tear) 

subroutine  to  return* 

•ass  fractions  (w's) 

•ole  fractions  <y' s) 
concentration  (ccC»3ks/a**3) 
density  (rhoC»3kS/a**3) 
molecular  weight  (ua) 
enthalpy  (C»3J/kS> 
temperature  (tearC»3K> 

for  a  mixture  froa  DEN  looked*  of  adiabatic  mixing  calculation 
den(l*i)  sole  fraction  (ye) 

den(2»i)  concentration  (cc  C*3  ks  c/a*X3) 

den(3#i)  mixture  density  (rho  C*3  ks  mix/a«3) 

den(4»i)  Mixture  enthalpy  (enthalpy  C*3  J/ks) 

den(3*i)  Mixture  tsarerature  (teap  C~3  K) 

ifl  indicates  given  information: 

-2)aole  fraction  (Yc)  and  assuaption  of  constant  saaaa  in  enthalpy 
- 1 ) concentration  (cc)  and  assuaption  of  constant  saaaa  in  enthalpy 
0)  concentration  (cc) 

1)  aass  fraction  c  (uc) 

2)  aole  fraction  (Yc) 


Implicit  Realtt  (  A-H*  0-Z  ),  Inteser*4  (  I-N  ) 


include  'sysfdeSadislDEGADISIN.dec' 
c 


coaaon 

S/QEN2/  DEN(5*iSen) 

l/'rarm/  uO»zQ>zr»al»ustar»k*s*rhoe*rhoa*delta»beta?Saaaaf »cclow 
1/coa.sr ror/  sas.aw  r sas. teap  t gas.  rhoe  *  sas_crk  > sas. err  * 

*  sas.uf 1 t sas. 1 f 1 » sas.ssr * sas.naae 

1/coaata/  istab » taabrramb»huaid» isof 1 *tsurf » ihtf 1 rhtcor iutf 1 rwteo 
c 

character*3  sas.naae 
realX8  alrk 
c 

ettt  data  for  3ir/uater  sys 

c 

data  uaa/23'?&/  f  molecular  weight  of  air 

data  umu/18./  '  molecular  weight  of  water 


c 
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iffifl.na.  0)  doto  1000 
cel  »  cc 

if(cc  .It.  0.)  ccl*0. 
i  *  2 

30  if(dan(l>i)  .dt.  1.)  than 

i*i-l 

iffcc.dt.  dan<2»i>>  ccl*dtn<2»i) 

doto  30 

endif 

if fee. la.  den(2>i))  Soto  50  !  lookun  in  concentration 

i*i+  1 
goto  30 

50  slona  »  (dtn<3» i)-den<3»i-l)>  /  (den<2>i)-den(2»i-l))  !  intern  in  cone 
pho  a  <cel  -  dan(2#i-l) >Xslore  +  den(3»i-l) 
ucl  =  ccl  /  rho 
UC  a  ucl 

ua  a  (i,-uc)/(i.+huaid)  !  no  choica  with  divan  inforaation 

uu  a  huaidXwa 

ua  a  1 . / ( uc/das.aw  +  ua/waa  +  uw/uaw) 
vc  3  wa/das_aw  X  wc 
sa  >  ua/waa  X  u a 
doto  9000 


1000  if(ifl.na.  -1)  doto  1300 

CCl  *  CC 

if (ccl.lt.  0.)  ccl30, 

daaaa  «  enthalrs 

uc  a  ecl/f rhoa+cclXdaaaa) 

ua  3  (i.-uc)/(i,+huaid)  !  no  choica  uith  divan  infopaation 

uw  »  1 , -WJ-WC 

ua  3  1,/f uc/das.aw  +  ua/waa  +  uw/uaw) 
vc  “  ua/sas.aw  *  uc 

sa  «  ua/uaa  X  ua 

Pho  a  ecl/uc 
return 
c 
c 

1300  iffifl.na.  -2)  doto  1700 

SCl  »  SC 

iffscl.lt.  0.)  scla0. 
daaaa  -  anth-ilrs 
yu  »  <l,-*a-scl) 

ua  >  sctdas.au  +  satwaa  +  sutuaw 

uc  3  das.aw/ua  X  scl 

ua  >  uaa/ua  X  sa 

cc  3  ucXrhoa/fl.  -  daaaatuc) 

pho  ■  cc/wc 

return 
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1700  iftifl.ne.  2)  soto  2000 
wcl  «  we 

if  (wc  .It.  0»)  then 
wcl  *  0. 

ua  »  l./<l.+huaid) 
uw  a  i.-w* 

wa  a  1  ./(waa/ua  f  waw/ww) 

W3  «  wa/WM  *  wa 
endif 

if (we  .at.  I.)  than 
wcl  3  1# 
wa  a  0' 
endif 
i  a  2 

1720  if(den(l»i)  .at.  1.)  than 
i  -  i-1 

aoto  1730  *  extrapolate 

endif 

if(wc.le.  den(lti))  aoto  1730  !  lookup  in  aola  frac 

i*i+l 

aoto  1730 

1730  slope  *  <den(2»i)-den(2»i-l>)  /  (den(l>i)-den(l»i-l))  !  interp  in  w 
ee  *  (wcl  -  den<l»i-l))  talope  +  den(2»i-l) 
slope  *  (den<3»i)-den(3ii-l>)  /  <den<l>i)-den(l>i-l))  !  interp  in  a 
rho  *  (wcl  -  den<l»i*>t))tslore  +  den(3»i-t) 

uc  *  cc/rho 

wa  a  yciaaas.au  +  watuaa  +  (l.-wcl-wa)*uew 
ua  *  waXuaa/wa 

i  *  2 

1760  if(den(lfi)  .at.  1.)  then 
i  *  i-1 

aoto  1800  !  extrapolate 

endif 

cue  *  den<2»i)/den(3>i) 

if(uc.le.  ewe)  aoto  1800  !  lookup  in  aass  frac 

i*i+l 

doto  1760 

1800  wl  «  den(2>i-l)/den(3»i-l) 

w2  *  den(2>i)/den(3»i) 

slope  »  <den(4>i)-den(4»i-l))  /  (w2  -  wl)  !  interp  in  w 

entholrw  »  (we  -  wl)  tslone  t  dent 4 1 i-1) 
slope  »  <den<3>i)-den(3»i-l))  /  (w2  -  wl)  !  interp  in  w 

teap  »  (wc  -  wl)  Jslope  ♦  «len<5ii-l) 

return 


2000  iftifl.ne.  1)  aoto  9000 
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ucl  *  we 

if(uc  .It.  0.)  then 
wcl  “  0. 

ua  a  l./d.+hueid) 
tndif 

if (we  .St.  1.)  then 
wcl  *  1. 
us  *  0. 
tndif 
WW  »  1.-W3-WC1 

we  *  l./(ucl/sas_ew  +  wa/waa  +  uw/waw) 
sc  a  wa/sas-aw  iwcl 
v3  s  ua/uaa  *ua 
i  *  2 

2030  if(dem'lri)  .at.  1.)  then 
i  *  i-1 

Soto  20S0  !  extrapolate 

tndif 

if(wc.le.  den(l»i))  Soto  2030  !  lookup  in  aole  free 

i»i+l 

Soto  2030 

2030  slope  *  (den(3»i)-den(3»i-D)  /  (den(l»i)-den(l»i-l) ) 
rho  »  <sc-den(l»i-l))Sslop#  f  den(3»i-l) 
slope  »  (den(2>i)-den(2>i-l))  /  (den(l>i)-den(l»i-l) > 
ce  a  (sc-den(l»i-l))*slope  +  den(2>i-l) 
i  »  2 

2060  if(den(lfi)  .st.  1.)  then 
i  »  i-1 

Soto  3000  !  extrapolate 

tndif 

ewe  *  den(2>i)/den(3*i) 

if (wcl. It.  cue)  Soto  8000  !  lookup  in  aass  frac 

iaid 

Soto  2060 


c 

c 

3000  ul  »  den(2>i-l)/den(3>i-l) 

u2  3  den(2»i)/den(3»i) 

slope  ■  (den(4»i)-den(4»i-l))  /  (w2  -  wl)  !  inter?  in  w 

enthalpy  *  (wcl  -  wl)  Sslort  +  den(4»i-l) 
slope  *  (den(3>i)-den(5>i-l))  /  (w2  -  wl)  !  inter?  in  w 

tee?  -  (wcl  -  wl)  Sslore  f  den(3fi-i) 
c 

return 


c 

?000  call  tra?(26) 
end 
c 
c 

subroutine  setenthal(h_Basrttfh_airrte>h_watrte) 

c 
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c  subroutine  to  load  /coauENTHAL/  through  massed  arsuaents  if  needed 

c 

c 

Iaelicit  Real*8  (  A-H>  0~Z  )>  InteSer<4  (  I-N  ) 

include  '^stdcdodisJDEBADISIN.dec' 
c 

coeaon 

S/coa_ip  roe/  Sas_au » sas-teap » las. rhoe»  sas.cpk >  sss.cpp » 
t  sas_uf 1 » sas_lf 1  »  da-i-zsp *  sas^naae 

»/coaa ta/  i stab » taab » paab  »  huai d » i sof 1 » t su  rf » ihtf 1 » htco » i wtf 1 » utco 
c 

eharacter*3  sas-naae 

c 

cm  data  for  air/uater  sms 

c 

data  epa/1.0063e3/  !  heat  capacity  of  air  C»3J/ks/K 

data  cpu/ 1863./  !  heat  capacity  of  water  vapor C*]J/ks/K 

c 

h_aasrte  ■  0. 
h.airrte  *  0, 
h.uatrte  »  0. 
c 

ifCisofl.eo.  1)  return 
c 

h.aasrts  »  cpc ( sas-teap ) t < sas.teap  -  taab)  !  TR«taab 

c 

c  h-airrte  3  (l.+huaid)*cpa»(taab  -  taab)  3  0. 
c 

if(iuatfl  .eo.  0)  return 
h-uatrte  *  cpw*(tsurf  -  taab) 
c 

return 

end 

c 

c 

c 

subroutine  setden(wc>wa» enthalpy) 
c 

c  subroutine  to  load  /6EN2/  as  needed 
c 

c  adiabatic  eixins  of!  UC 
c  WA 

c  uy  8  specified  enthalpy 

c 

c  with  aabient  huaid  air  8  taab 

c 

c  den<l>i)  sole  fraction  <yc) 

c  den<2>i)  concentration  (cc  C*3  ks  c/et>3) 

c  den<3>i)  ii;;ture  density  (rho  C*3  ks  ai::/af*3) 
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c  d*n(4»i)  Mixture  enthalpy  (enthalpy  C*3  J/k3) 

c  den(5»i)  Mixture  temperature  <t«ap  C*]  K) 

c 

c 

Illicit  RealX8  <  A -H»  0-2  )  t  Inte*ert4  (  I-H  ) 

include  'swetdcdadie.'DCSADISIN.iiec' 
c 

parameter  (terit*0.002i  zero»l .e-20) 
parameter  <iils*200i  il**iils-l»  i back *23) 

c 


common 

I/GEN2/  OCN(Siiacn) 

*/com_3p r or/ ' iasjM  i das. tear » lai. rhoa  *  aas-cr k ?  aas_err » 
t  3as»uflida*_lflida»_2*aiijs_naae 

l/comata/  istab»taabiraab>humid»isofl>tsurf »ihtfl»htco»iutfliwtco 

c 

character *3  3as_naae 

c 

diaansion  curnt(3)*backsr<3»ibacJO 

c 

ctX*  data  for  air/uatar  tvs 

c 


data  uma/28.94/ 
data  wmu/13./ 
data  cra/1.0063#3/ 
data  cpu/ 1863./ 


!  aoltcular  weiaht  of  air 
!  Molecular  weiaht  of  water 
!  heat  capacity  of  air  C*3J/ks/K 
!  heat  capacity  of  water  vaporOU/ka/K 


c 


ifCisofl.ea.  1)  return 
e 
c 

k  *  1 

den(lik)  *  0.0  !  yc 

dan(2»k)  »  0.0  !  cc 

deo(3ik)  a  paebt(l.+humid)/( .00283+  .00456thumid)/tamb  !  rhoa 
dan(4»k)  *  0.0  !  enthalpy  of  aabient  air*  TR*tamb 

den(Sik)  =  taab 
c 
c 

do  300  i»  ilsili-1 

zbda  *  (float(i)/float(iils)>  /  (l.+huaid) 
zw  *  zbdathuaid 
zs  *  t.-zbda-zw 
c 

c  enai::  «  zafenthalry  +  zbdatd  .+humid)tcrattamb  !  TR*tamb 
enaix  *  zatanthalpy 
c 

zbda  3  zbda  +  zatwa 
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23  a  23*UC 

call  trrop(2>z3?zbda'enaix>MC7yaiuef teeerrho>cp) 
cc  »  zstrho 
c 
c 

curnt(l)  *  *c 
curnt(2)  *  cc 
curnt<3>  *  rho 
cupnt(4)  «  eneix 
curnt(5)  *  t#«p 
c 

if(i  .eo.  ils)  then 
ind  »  i 

do  150  JJ*  1»5 

ISO  backsp(JJi ind)  a  cumt(jJ) 

30 to  200 
•ndif 

c 

c  AOIABAT  interpolation  scheme 
c 

err  a  o. 

do  180  iind  a  i,ind 
tic  >  backsp<l»iind) 
cc  *  backsp(2>iind) 
rho  a  backsp<3»iind) 
en*ix  a  bacfcsp<4f iind) 
te«p  a  backsr(3>iind) 

slop#  a  (den(2»k)-  curnt<2))  /  (den(lik)-  eurnt(l)) 
ccint  •»  (yc  -  cupnt<l))*tlope  +  curnt(2> 
srr  a  d«axl(err»2.B0*  abs(cc  -  ccint )/(abs(cc  +  ccint)  +  zero)) 
slope  ~  (den(3»k)-  curnt<3))  /  <den(l»k)-  curnt(l)) 
rhoint  »  <«c  -  curnt(l) Xsloee  +  curnt(3) 

•pp  »  daaxl(errr2.D0*  3bs(rho  -  rhoint)/(abs< rho  +  rhoint)  +  zero)) 
weeal  a  cc  /  rhoint 

ul  a  curnt(2)/cupnt(3) 
m2  »  dtn(2»k)/den(3»k) 
slope  3  (den(4?k)-  curntM))  /  (m2  -  m!) 

entint  *  (weeal  -  wlXslope  +  curnt(4) 
err  =  daaxl(errr2»D0t  abs(en«ix  -  entint )/(ab«(enaix  t  entint)  +  zero)) 
slope  *  (den(S»k)  -  cumt(5>)  /  (m2  -  m1) 

teeint  *  (weeal  -  wDSslope  ♦  curnt<5) 
err  »  daaxl(err»2.D0*  abs(te*p  -  teeint)/(abs(teep  +  teeint)  +  zero)) 
180  continue 
c 

if(err  .le.  tcrit)  then 

if (ind  .3e»  iback)  koto  200 
ind  »  ind  +  1 
do  190  JJal»S 

190  backsp< JJrind)  *  curnt(JJ) 

Soto  300 
end  if 
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c 

c  record  a  point  in  DEN 

c 

c 

200  k  *  k+1 

ifik.se.  isen)  call  trap<28) 

do  250  JJ*1»5 

den< JJ»k)  *  backtP<JJfind) 

250  b3Cksp(JJ»l)  *  curnt(JJ) 
ind  »  1 
c 

300  continue 

c 

k  a  k+1 

if(k.3e.  isen)  call  trap(28> 
if(wc.eo.  1.000)  then 

den(lrk)  »  1.D00  !  ac 

den(2»k)  ~  sas_rhoe  !  cc 

den(3»k)  a  aas.rhoe  <  rhoe 

den(4fk)  »  enthalpy  !  enthalpy 

den<5»k)  *  3 as. t see  !  teap 

else 

call  tProp<2»uc>u3ienthalpy»den<l>k)»ya»ua»den<3»k)>den(3»k)»cp> 
den<2»k)  a  uc<den<3»k)  !  ce 
den(4»k)  a  enthalpy 
endif 

den(l>k+l)  a  2.  !  .at.  1.  end-of-record  indicator 

c 

return 

end 

c 

c 

c 

c 

sub  routine  addheat ( cc  >  dh » rho  ? teap  > cp ) 


Implicit  Rea 1*8  (  A-H>  0-Z  )»  Inteser*4  (  I-N  ) 

include  'sysidesadislDEGADISl .dec' 

c 

paraaeter  (tf rac=0.618»  tfracl«l.-tfrac> 

1  rerit»0.005f  acritai.,  zero»l.e-20) 

c 

coaaon 

I/GEN2/  DEN(5»isen) 

l/coa.ap top/  sas.aw » 3«. teap  t its.  rhoe r sas.cpk » sas.cpp » 

I  aas.uf 1 1 sas.lf 1 » sjs.zsp  t sas.naae 

•/coaa ta/  i s tab » taab » p#ab » hua i d » i sof 1 » tsurf > ihtf 1 >  hteo » i wtf 1 >  wtco 
c 

character*3  sas.naae 
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c*«  data  for  air/water  sws 
c 

data  mm/28.96/ 
data  waw/18./ 
data  rho-water/1000./ 
data  cpa/1 .0063*3/ 
data  cpw/1865>/ 
data  dhvap/2>3023e6/ 
data  dhfus/0.33e6/ 
c 

logical  r*v 
c 
c 

vaPor_p(txxx>  3  6.0298e-3*  exr<3407.  *<1./273.13-  l./txxx>) 
sat_hua(p.tot*p_vp)  3  0.622*  p_vp/  (p,tot-  p_vp)  !  kd  w/kd  BDA 
roPu„3ir(p-tot>huaxx)  * 

1  (.00283+  .00436*huax>:)/p_tot/(l  ,+huaxx)  !  at*3/kd  /K 


CP  3  CM 

IF(isofl.ta.l  .or.  ihtfl.ea.O)  return  !  adiabatic  eixind  is  valid 
rhoa  *  den(3»l) 

call  adiabat(0»wc>wa>yc»y*>ccr rhotwar enthalpy taat) 
tea p  3  amt 

ifCdh.ea.  0.)  return 
enthalpy  3  enthalpy  +  dh 


if (dh.lt.  0.)  return  !  catch  colder  surface  teareratures 


!  aolecular  weidht  of  air 
!  aolecular  ueidht  of  water 
!  liauid  water  density  [»]  kd/a**3 
'  heat  capacity  of  air  C»]J/kd/K 
!  heat  capacity  of  water  varorC*lJ/kd/K 
!  latent  heat  of  vap  C»3JAd  water 
.'latent  heat  of  fus  C»3JAd  water 


ft 


c 

c 

c 


c 

c 

c 


if (enthalpy. dt.  0.)  then 
teap  >  taab 
doto  400 
endif 


100 


continue 
tain  a  3at 
tainO  3  tain 
taax  3  daaxl( tsurf rtaab) 
taaxO  -  taax 
teap  3  ( tain+taax)/2. 


adiabatic  aixind  teap 


do  300  J31 » 33 

duess  3  enthal (wc»wa» teap) 

dif  3  enthalpy  -  duess 
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sum  3  (abs( enthalpy)  t  abs(duess) )/2.  +  zero 
if(abs(dif)/sua.le.rcrit  .or.  abs(dif).le.acrit)  Soto  400 

C 

if(dif.lt.  0.)  then 

if (rev)  taax  3  temp 

if (.not. rev)  tain  3  teap 

teap  3  tain  f  (taax-tain)  *  tfrac 

else 

if (rev)  tain  3  teap 

if (.not. rev)  taax  3  teap 

teap  3  tain  +  (taax-tain)  t  tfrael 

endif 

c 

300  continue 

rev  3  .not. rev 
if (rev)  doto  100 

c  urite(lunlod»8030)  uc>ua» enthalpy >duess» teap 
cSOSO  foraotC'  ADDHEAT?  wc:  '»1p312.5»1x» 
c  1  'via:  '»lpdl2.3»lx» 'enthalpy!  '»1p312.5»/» 

c  1  '  Suess!  '»lPdl3.3»'  teap)  '»l?dl3.5) 

if(teap.lt.  aat)  call  trap(17) 
slow  3  enthsl(wc»«3» tainO) 

if (enthalpy.lt.  elou)  then  !  catch  out  of  bounds  nuabers 

teap  3  tainO 
enthalpy  3  elow 
duto  400 
endif 

elou  3  enthaKucruai  taaxO) 
if (enthalpy. dt.  elou)  then 
teap  3  taaxO 
enthalpy  3  elou 
doto  400 
endif 
c 

C3ll  trap(17) 


500  continue  !  density  calculation 

vp  3  vapor-p(teap) 

eat  3  dainl(  sat_hua(paabrvp) »  huaid) 

rho  3  l./(teaptroPu_air(paabrs3t)Xua*(l.+sat) 

1  +  uctteap/das-teap/das-rhoe  +  (ww-waXsatl/rho-vater) 

if  (teap.  ne.  sat)  cp  3  daaxKdh/Cteap-aaOfCpa) 
if (teap. It. aat)  stop'  ADDHEAT?  urond  uay.' 
c 
c 
c 

return 

end 

♦♦♦* 
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FILE  NAME  TRANS1  —  FOR  USE  IN  DEGADIS1 


SUBROUTINE  TRANS (FILE) 


Illicit  RcaltS  (  A-H*  0-2  )»  Intadar*4  (  I-N  ) 
include  'sysMedadisJDEGADISl.dec' 

BLOCK  COMMON 
COMMON 

4/GEN3/  r add ( 2 > aaxl ) * ast  r ( 2 * tax 1 ) *  s redan ( 2 * aaxl ) * s rewe <  2 * taxi ) * 

*  srcwa(2*aaxl ) *srcanth(2*eaxl ) 
l/TITL/TITLE 

t/GENl/  ET(2*i3an)*RlT(2*i3en) 

3/GEN2/  DEN(3*iSan) 

4/ITI/Tl , TINP » TSRC , TOBS * TSRT 

I /ERROR/S TP IN t ERBND * STPMX  * UTR6 » WTta  * WTy  a t utac >  wteb * wtab , wtuh * XLI * 

*  XRI * EPS » ZLOU » STPINZ » ERBNOZi STPMXZ  *  SRCOER » *  res*  r  srccut , 

$  htcut * ERNOBL » NOBLat *  erf  Sa  r  »ai*si  Ion 

5/PARN/UO, ZO. ZR*ML .USTAR* K»0»RH0E»RH0A» DELTA, BETArGANHAF,CcLOH 
$/coa_si*  roa/  3as_*w * sas_  teaa»  das.  r hoa » aas_cak.  >  das-caa * 

*  sas_ufl*aas_lfl*33s.rsp*s.is_naao 

S/coaata/  istab* taab*  aaab*huaid* isof 1 * tsurf * ihtf 1 >htco  * iwtf 1 * wteo 
J/PARMSC/  RNtSZN* EMAX * RMAX * TSC1 * ALEPH* TEND 

3/coa-ss/  ass* *lan» swid>autcc*outsz*outb*outl>swcl*sual*sanl*srhl 

* /PHLAG/CHECK 1 * CHECK2 ; AG A IN  *  CHECK3  *  CHECK4 * CHECKS 

l/coa_sidx/  sidx.coaff *siax_*ow*si3x_ain_dist>siax_flaS 

*/coa_anthal«'  h_aasrta»H_airrta»H.M3trta 

t/NEND/  POUNDN* POUND 

l/ALP/  ALPHA* alahal 

l/ahicoa/  ii»bifl*dallax 

l/sard_con/  c a*  dalrhoain 

l/C0M_SURF/  HTCUTS 

charactartSO  TITLE(4) 

eiiaractart4  pound 
charaetar*24  TSRC* TINP* TOBS* TSRT 
character *3  das.naae 

REAL f 8  ML*K 

LOGICAL  CHECK 1 » CHECK2 *  AGAIN  *  CHECK3  * CHECK4 *  CHECK3 
charactartd)  fila 


-  swsIdeaadisJTRANSl.FOR 
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OPEN <  UNIT38 » NAME*FILE» TYPE* ' NEW' » 
<  esppiasecontpola'list'f 
i  pocopdt¥Pe*'vari3ble'> 


WRITE(8»1000)  (TITLE(I)»I*1»4) 
1000  FORMAT (A80) 


00  100  I*l»iSen 

100  IF(ET(1>I).EQ»P0UNDN  .AND.  ET(2»I) .EQ.POUNDN)  60  TO  105 
stop  '  POUND  HAS  NOT  DETECTED  ' 

105  NP  *  I  -  1 

URITE<8»1040)  NP 
DO  110  I*1»NP 

110  WRITE(3»1030)  ET(l.I) »ET(2»I) .R1T(2»I) 


DO  120  I*l»isen 

120  IFCDENClrl)  .St.  1.)  GOTO  125 
DO  122  I»l»iSen 

122  WRITEC8* 1060)  DEN<l>I)»DEN<2»I)»den<3»i)»den(4»i)»den(5»i) 
stop  '  density  function  blow  the  loop' 

125  NP  »  I  -  1 

HRITEOf  1040)  NP 
DO  130  I*1»NP 

130  URITE(3> 1060)  DEN< 1*1) »DEN(2»I) ,den(3»i ) >den(4» i) ,den(5.i) 


DO  140  I3l,«axl 
cc  =  srcwc<2»i)*spcden(2f i) 
ifCcc.lt.  cclow )  then 
fee  *  0. 
do  ii*i-fl>B3xl 

fee  3  3B3xl(sPcwc<2»ii)*spcden(2iii)*fec) 
enddo 

ifCfcc.se.  cc)  soto  140 
np  *  i 

tend  ■  spcwcClfi) 
soto  146 
endif 

140  IF ( pads < 1 » I ) . EQ . POUNDN  .AND.  psds<2>l) .EQ.POUNDN)  60  TO  145 
stop  '  POUND  HAS  NOT  DETECTED  ' 

145  NP  »  I  -  1 

146  HRITE(3» 1040)  NP 
DO  150  I  *  1 » NP 

130  WRITE(3>1060)  P3dS<l>i)f P3ds(2>i)»astp(2>i)»spcden(2»i)>spcwc(2fi) 
1  rsrcw«(2ri)rsrcenth(2ri) 


1020  fope3t(lx»i4»ix»lPSl4.7) 
1030  fop»3t(3(lXflPSl4.7)) 
1040  fop«3t(lx»i4) 

1050  f 0Pi8t(2<324flx)) 

1060  for»3tC7(lx>lPSl4.7)) 
1070  fopeatC lx» 1P314.7) 


2  —  sxsSdesadisJTRANSl.FOR 


C-168 


1080  foraat(a3) 


c 


«RITE<8»1050>  TINPfTSRC 
uritt<3>10S0)  TOBSfTSRT 
WRITE<8»1060>  UO>ZO»ZR>ffl.*USTAR 
urita<8»1060)  K»G»RHOE»RHOA> DELTA 
uritt(8»1030)  BET  A » 6AHMAF  > CcLOU 
WRITE (3 r 1060)  RMrSZHfEMAX»RHAX»TSCl 
uritc(8f 1030)  ALEPH»TEND 

WRITE<8»*>  CHECK 1 > CHECK2 > AGAIN » CHECK3 » CHECK4 » CHECKS 
«RITE(8»1070)  ALPHA 
urita<8»1080)  3as.naaa 


wpite(3i 1030) 
urite(8>1030> 
wpite(3f 1030) 
write(8>1040) 
uritg(3»1030) 
writ»(S»1020> 
writ@<8»1020) 
urit*<8»1020) 
urit»<3» 1030) 


3as.au » sss.tgsp » das. rhoc 

sas.gf 1 » sas.l  1 1 » sas_rsj» 
is  tab 

taab»paab<huaid 

isofl>tsurf 

ihtflihtco 

iwtfl»uteo 

sisx.coaff  rsisx-Mursisx.ain_dist 


if(check4)  than 

urite<8>1030)  •s*>sl*n>swid 
writaOf  1060)  autccroutsz>outbrautl 
urite<8»1060)  sucl/sual»s»nl»srhl 
«nd  if 


c 

uritg(3>1020)  ij»hifl  >dtlla* 
c 

iffisofl.ta.  0)  urit«<8>1030)  H_aasrt» 

c 

WRITE(8» 1030)  HTCUTS»  c*>  dalrhoain 
C 

CLOSE < UNI T*8) 

C 

RETURN 

END 
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FILE  NAME  TRANS3  —  USE  WITH  DEGADIS3 
SUBROUTINE  TRANS (FILE) 


Illicit  Real *8  (  A-H?  O-Z  )»  Inteder*4  (  I-N  ) 

include  '  susldesadis i DEGADIS2 .dec ' 
c 

COMMON 

9/SSCON/  NREC ( aaxnob ? 2 ) *  TO ( aaxnob ) ? XV  < aaxnob ) 

4/GEN2/  D£N(5?iden) 

9/ITI/  T1?TINP?TSRC?T0BS?TSRT 

9/P ARM/  UO ? ZO ? ZR ?  ML  ? USTAR ? K ?6 ? RHOE» RHOA ? DELTA? BETA ?  6AMMAF ?  CcLOW 
9/coa_se  rap/  sas..aw  >  S3S_teai»  >  sas-rhoe  >  sas.oHt  ?  S3*.cw  ? 

9  S4s_ufl?sas_lfl»sas_2sp»sas_naae 

i/coaata/  istab?taab?paab?huaid?isofl?tsurf ?ihtfl?htco?iutfl?utco 
9/PARMSC/  RM?  SZM? EMAX ? RMAXiTSCl ? ALEPH?  TEND 
9/PHLA6/  CHECK 1 » CHECKS ? AGAIN? CHECK3  ? CHECK4 ? CHECKS 
5/coa_sidx/  sidx_coeff ?sisx_Po«?sisx_ain_dist?sisx_flas 
9/ner.d/  roundn? round 
9/ALP/  ALPHA? alrhal 
9/ CHOPS/  NOBS 
c 

char3cter*3  das-naae 
character*80  TITLE(4) 
char3Cter«S4  TINP?TSRC?TOBS?TSRT 
character^*)  file 

c 

REAL28  K?ML 

LOGICAL  CHECK 1 ? CHECKS ?  AGAIN ? CHECK3 ? CHECK4 ? CHECKS 

r 

OPEN ( UNIT*?  ?  NAHE*FILE  ?  TYPE* 'NEW'? 

9  c3PPiaaecontrol*'li5»t' ? 

9  recordtyre*'variable') 

C 

WRITE(??1040)  NOBS 
DO  1SS  1*1 ?NGBS 

1SS  WRITE(?? 1010)  NREC(I?1)?NREC(I?3)?T0(I)?XV(I) 

c 

DO  140  I*l?iden 

140  IF(D£N(l?I>.St.  1.)  GOTO  145 

stop  '  density  function  error  in  TRANS' 

14S  NP  *  I  -  1 

WRIT£(9? 1040)  NP 
DO  ISO  1*1 ?NP 

ISO  WRITE(?? 1060)  DEN(l?I)?DEN(3?I)?den(3?i)*den(4?i)?den(5?i) 

C 

WRITE(9?1060)  U0?Z0?ZR? ML? USTAR 
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urita<9»1060>  K»G»RHOE>RHOA» DELTA 
writa <9rl030)  3E7 A » GAHHAF t CcLOW 
c 

HRITE(9f 1030)  TINPiTSRC 
«pit«<9»1050)  T0BS»T3RT 
c 

WRITE(9> 1060)  RM  > SZM t EMAX t RHAX t TSC1 
uritc<9»1020)  rtLEPH»TEND 
c 

writt<9»1080)  Msjmsi 

writ«<?»1030)  a3S_awrS3S-t*«*»S3*_rhoa 

writ»(9> 1020)  3»s_c?k»a»*_c^ 

uri t#< ?t 1030)  S3f_ufl t Sas_lf 1 /*as-£SJ» 

urita<9*1040)  istab 

urit»(9>l030)  taabiaaab'huaid 

Mrite(9»102S)  isoflitsurf 

urita<9*1025)  ihtflihtco 

uri t*(9» 1025)  iutfl>wtco 

writ«<9»1030)  siSx-coaff »«Hx_*owrsiax_ain_dist 

c 

MR I TE ( 9  *  * )  CHECK 1 » CHECK2 1 AGAIN  * CHECK3 >  CHECK4 » CHECK5 

c 

WRITE (9, 1070)  ALPHA 

c 

1010  foraat<lx»i8.1x»i8»2<lx,lMll4.7>) 

1020  for»jt(2<lxflf>3l1,7>) 

1023  foraat(lx»i4»lxtl»*al4.7) 

1030  far*at<3<lx»l*Sl4.7)) 

1040  for«at(lx»i4) 

1030  fomat<2(a24,lx)) 

1040  foraat(3<lXflaal4.7)) 

1070  fop*at<lx»lMl4.7) 

1030  foraat(a3»lx) 

£ 

CLQSE(UNIT*9) 

RETURN 

END 

**** 
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FILE  NAME  TRANS2  --  USE  U1TH  SDEGADIS2 

SUBROUTINE  TRANS < FILE) 


Illicit  Real*8  (  A-H.  0-Z  )»  IntederM  (  I-N  ) 

COMMON 

S/PARM/  UO » ZO » ZR . HL » USTAR » K » 6 * RHOE > RHOA .DELTA. BETA . GAHMAF . CcLOW 
*/coa_Sprop/  aau-aw. 33* _te»p >  Nat. riioa .  S3S_cPk .  aas.cpp » 

$  sas_ufl.s3s_lfl.d3s_zsp.sas.n3ae 

t/coaata/  istab* taab.paab.huaid. isof 1 » tsurf » ihtf 1 .htco. iutf 1 .wtco 
S/ITI/  tl.TINP.TSRC.TOBS 

S/PHLAG/CHECK 1 » CHECK2 .AGAIN. CHECK3 . CHECK4 . CHECKS 
S / ALP/ ALPHA . a 1 Pha 1 

character*24  TSRC.TINP.TOBS 
chancter*3  sas.-naae 
character^*)  file 

REALX8  K.HL 

LOGICAL  CHECK 1 . CHECK2 . AGAIN. CHECK3 . CHECK 4 . CHECKS 

0P£N(UNIT=9»NAHE*FILE» TYPE* 'NEW') 

WRITE(9»1060)  UO.ZO»ZR.rtL .USTAR 
write <9. 1040)  K.G. RHOE. RHOA. DELTA 
write<9.1030)  BET  A » GANNAF . CcLOM 

URITE(9»1030)  TINP.TSRC 
write(9. 1030)  TOBS 

urite<9.1080)  Sas.naae 
write<9.1030)  sas.aw . das. teap . sas. r hoe 
write <9. 1020)  sas.cpk.sas.cpp 
urite(9.l030)  aas.ufl.aat.lfl.aas.zsp 

write<9.1040)  istab 
write<9.1030)  taab.paab.huaid 
write(9»102S)  isofl.tsurf 
write(9.102S)  ihtfl.htco 
write(9»1023)  iwtfl.wtco 

WRITE  <  9 . *)  CHECK 1 . CHECK2 » AGAIN . CHECK3 . CHECK4 » CHECKS 
swstdedadis ! TRANS2SS . FOR 
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yRITE(?»1070)  ALPHA 

m 

u 

CLOSE (UNIT*?) 
c 

1020  for«at<2<lx»lMl4.7>) 
1023  fonMt(tx»i4»lx>lMl4.7) 
1030  forMt<3Ux»lMl4.7>) 
1040  forMt(lXfi4) 

1050  fora»t(2(a24*lx)) 

1040  forMt(3(lx»lMl4.7)) 
1070  for*at(lx>l?4l4>7) 

1080  for»at<33ilx) 

C 

RETURN 

END 
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FILE  NAME  TRANS3  FOR  USE  WITH  DE6ADIS3 


SUBROUTINE  TRANS (QPNRUP) 
c 

Illicit  R#al*8  (  A-H,  O-Z  >»  Integer *4  <  I-N  ) 

include  ' saatdusadis i DEGADIS3. dec/1 iat ' 

C 

COMMON  /SORT/TCc( aaxnob, aaxnt) »TCcSTR( aaxnob, aaxnt) , 

*  Tac  < aaxnob » aaxnt ) *  T  r ho  <  aaxnob > aaxnt ) » 

S  Tdaaaa < aaxnob  » aaxnt ) > Tten»  (  aaxnob » aaxnt ) » 

*  TSY( aaxnob, aaxnt) ,TSZ( aaxnob, aaxnt) ,TB( aaxnob, aaxnt) » 

9  TDISTO ( aaxnob  » aaxnt ) » TD I ST  ( aaxnob » aaxnt ) » KSUB ( aaxnt ) 

*/SORTIN/TIM(aaxnt) ,NTIN, ISTRT 

*/ ITI/T1 1 TINP  , TSRC , TOBS  > TSRT 
C 

character*24  tin*»tsrc>tob«»tsrt 

w 

character^*)  OPNRUP 
C 

TO  *  TIM( ISTRT) 

DT  =  TIMdSTRT+l)  -  TIM< ISTRT) 

C 

OPEN  (UNITa?,  NAHE=*QPNRUP ,  TYPE* ' NEW ' , 

*  carriadecontroi*' list' »pecordtaee»' variable' ) 

C 

C 

DO  110  I  *  ISTRT, NTIM 
II  *  I  -  ISTRT  +  1 
110  KSUB (II)  »  KSUB(I) 

NTIM  *  NTIM  -  ISTRT  +  1 
IF (NTIM  .EQ.  aaxnt)  GO  TO  120 
II  =  NTIM  +  1 
DO  115  I*II» aaxnt 
115  KSUB(I)  »  0 
C 

120  CONTINUE 
C 

WRITE(?>«)  TO, DT, NTIM 
URITE(?,*)  KSUB 
C 

C10SE(UNIT»?) 

C 

RETURN 

END 

♦### 


1  —  • astdaaadia : TR ANS3 . FOR 


SUBROUTINE  TRAP  —  DIAGNOSTICS 


SUBROUTINE  traMNtNl) 


Illicit  Raal*8  (  A-H»  O-Z  )t  Intt4»r*4  !  I-N  ) 
i nc 1 uda  ' svstdaaad i s l DEQAD ISl.dac' 

COMMON  /ITI/Tl t TINP  >  TSRC » TOBS  t  TSRT 
r«al*4  ttl 

charact*r*24  TINP . TSRC » TOBS i TSRT 

ch3P»ct»r*24  tt 

WRITE! lunlod» 1100 ) 

WRITE < lunlodt 1110) 
writa!lunlo3»1115)  n 

IF(N  .EQ.  1  )  WRITE! lunloi»2010)  N1 

IF!N  .EQ.  2  )  WRITE! Iunlo4»2020) 

IF!N  .EQ.  3  )  WRITE! Iunlo4»2030)  N1 

IF(N  .EQ.  4  >  WRITE! lunlo4» 2040) 

IF(N  .EQ.  3  )  WRITE! Iunlo4»2050) 

IF!N  .EQ.  4  )  WRITE! lunlodf 2040) 

IF!N  .EQ.  7  )  WRITE! Iunlo4»2070) 

IF!N  .EQ.  3  )  WRITE! lunlo4> 2080)  N1 

IF!N  .EQ.  9  )  WR I TE ! 1 un 1 04 » 2090 )  HI 

IF < M  .EQ.  10)  WRITE! Iunl04t 2100)  N1 

IF!N  .EQ.  11)  WRITE! Iunlo4t2110) 

IF(N  .EQ.  12)  WRITE! Iunlo4»2120) 

IF!N  .EQ.  13)  WRITE! Iunlo4r 2130) 

IF ! N  .EQ.  14)  WRITE! lunlodf 2140) 

IF(N  .EQ.  15)  WRITE (lunlo4> 2150) 

IF(N  .EQ.  14)  WRITE (lunlos? 2140) 

IF(N  .EQ.  17)  WRITE!lunlo4»2170) 

IF < N  .EQ.  18)  WRITE!lunlo4f21S0)  N1 

IF!N  .EQ.  19)  WRITE(lunlo4>2190)  N1 

IF!N  .EQ.  20)  WRITE! lunloai 2200) 

IF!N  .EQ.  21)  WRITE! Iunl04» 2210) 

IF!N  .EQ.  22)  WRITE !lunl04» 2220) 

IF!N  .EQ.  23)  WRITE!lunlo4»2230) 

IF!N  .EQ.  24)  WRITE!lunlo4f 2240) 

IF!N  .EQ.  23)  WRITE! Iunlo4»2230> 

IF<N  .EQ.  24)  WRITE! Iur»lo4»2240) 

IF(N  .EQ.  27)  WRITE! Iunlo4»2270) 

I F < N  .EQ.  23)  WRITE! lunlo«>2280) 


»s*d«S3dis I  TRAP. FOR 


C-175 


IF ( N  .EQ.  2?)  WRITE! lunlos#2290) 

IF (N  .EG.  30)  WRITE! lunlod»2300) 

IF'N  .EQ.  31)  WRITE! lunlod# 2310) 

IF! N  .£Q.  32)  WRITE ! lunlod » 2320 > 

IF!N  .EQ.  33)  WRITE ( lunl os » 2330 ) 

C 

1100  FORMAT ! 5X # 'The  best  laid  plans  of  sics  and  sen...') 

1110  FORMAT !5X» 'You  have  entered  a  TRAP  —  the  land  of  no  RETURN. ') 

1115  foreat!'  Code!  '#i4) 

2010  F0RMAT!5X» 'DESADIS1?  SOURCE  INTEGRATION  HAS  RETURNED  IHLF«'»I3) 
2020  FORMAT !5X# 'Reserved') 

2030  foraat!5x» 'SZF?  Local  integration  failed!  IHLFa'#I3) 

2040  foreat!5x» 'SURFACE?  Nesative  QRTE  for  positive  DELTA-T') 

2050  FORMAT !5X»'CRFG?  MORE  POINTS  FOR  GEN3  WERE  HEEDED') 

2060  FORMAT !5X»'TUPF?  OBSERVER  CALCULATIONS  —  TUPF  FAILED') 

2070  FORMAT !5X» 'TUPF?  OBSERVER  CALCULATIONS  —  TDNF  FAILED') 

2080  FORMAT <5X»'SSSUP?  OBSERVER  INTEGRATION  FAILED#  IHLF*'»I3) 

2090  FORMAT !5X» 'SSSUP/SDEGADIS2?  PSEUDO-STEADY  INTEG  FAILED#  IHLF='#I3) 
2100  FORMAT ( 5X # ' SSSUP/SDEGAD I S2?  GAUSSIAN  INTEGRATION  FAIL#  IHLF='»I3) 
2110  FORMAT !5X# 'SSSUP/SDEGADIS2?  TOTAL  Ho.  OF  RECORDS  EXCEED  120000') 
2120  F0RMAT!5X» 'Reserved') 

2130  FORMAT  <  5X » ' Reserved ' ) 

2140  FORMAT (5X» 'Reserved') 

2150  FORMAT (5X» 'Reserved') 

2160  F0RMAT!5X# 'PSSOUT/PSSOUTSS?  PSS  STARTED  WITH  B<0.') 

2170  foreat !5x» 'TPROP/ ADDHEAT?  Enthalpy  out  of  bounds') 

2180  FORMAT (5X»'ALPH?  ALPHA  INTEGRATION  FAILED#  IHLF=*'#I3) 

2190  FORMAT !5X»'ALPH?  RTMI  HAS  FAILED  TO  LOCATE  ALPHA  I ERR!  '#14) 

2200  f oraat ( 5x » ' ESTRT?  Preeature  EOF  in  RUN-NAME >ER1  or  RUN-NAME. ER2. ' ) 
2210  F0RMAT!5X» 'ESTRT1/ESTRT2/ESTRT2SS/ESTRT3?  DECODE  failed') 

2220  foreat!5x# 'ESTRT1?  The  paraeeter  file  RUN-NAME. ER1  uasnot  found.') 
2230  foreat ! 5x » 'S0RTS1?  Fewer  than  3  points  sorted  for  any  tiae.') 

2240  foreat!5x» ' TPROP?  Trial  and  error  loop  coeproeised') 

2250  foreat!Sx# 'TPROP?  Isothermal  density  loop  coeproeised') 

2260  foreat!5x» 'TPROP?  Invalid  entry  flad  in  ADIABAT') 

2270  foreat!5x» 'Reserved' ) 

2280  foreat(5x» 'TPROP?  IGEN  reouest  too  lards  in  SETDEN') 

2290  for*at!5x# 'PHIF?  flofl  out  of  bounds') 

2300  foreat!5x# 'SSSUP/SDEGADIS2?  concentration  Sreater  than  RHOE') 

2310  foreat!5x# 'SSSUP?  concentration  sreater  than  RHOE') 

2320  foreat!5x# 'PSS?  Ss  conversance  failure.') 

2330  foreat ! 5x » 'SSG?  Ss  conversance  failure.') 

C 

CL0SE(UNIT=9) 

C 

CALL  TRANS! 'trap. DBG') 

C 

istat  s  libtdate.tiee!TT) 
ttl  *  tl 

ttiae  »  secnds(ttl)/60. 

C 

2  —  sys4dedadis.TRAP.F0R 


140  WRITE (lunloat 3000)  TT 
WRITE (lunlnd> 3010)  TtiM 
3000  F0RMAT(1X» '  —  ENDin*  AT  '»A24) 

3010  FORMAT < 3X > '  *****  ELAPSED  TIME  *****  '»1M13.5»'  MIM  ') 
C 

CALL  EXIT 
END 

♦#** 


j«s*dtaadis: TRAP. FOR 
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. . • . 

c 

C  FUNCTION  TO  CALCULATE  A  SPECIFIED  TIME 
C 

FUNCTION  TS(T01>DIST) 

C 

Illicit  Rtal*8  (  A-H>  O-Z  )»  Int»Str*4  (  I-N  ) 
COMMON 

4/PARMSC/RM » SZM  *  EMAX » RMAX » TSC1 , ALEPH » TEND 
</ALP/ ALPHA* alphsl 
C 

TS  =  TOl  +  <DIST+RMAX)**<1./ALPHA1>  /ALEPH 
C 

RETURN 

END 

**** 


I 


* 

i 

1 


1  --  s*s*dtsadi*:TS.FOR 


c 

C  OBSERVER  TRIAL  AND  ERROR  FUNCTIONS 

C  —  TUPF - TDNF  — 

c 

c  Modified  4  Nov  3S  to  account  for  tore  General  fores  of  the 
c  Gas  Radius  as  a  function  of  tiee. 

C 

FUNCTION  TUPF (T01) 

C 


Implicit  Realtt  (  A-H,  0-2  >»  Inteser«4  (  I-N  ) 


include  ' susSdedadisl DE0ADIS2 .dec ' 

w 

COMMON 

8/GEN3/  rads(2,aaxl),<istr<2,eaxl) ,srcden(2,aaxl) ,srcuc<2,eaxl) » 
>  srcwa<2,»3xl)»srcenth<2»eaxl) 

$ /ERROR/S Y  OER » ERRO  >  SZOER , UTAIO » WTQOO ,  UTSZO » ERRP >  SMXP  > 

*  WTSZP > UTSYP , UTBEP , UTDH , ERRO *  SMXG » ERTDNF , ERTUPF , MTRUH » UTDHG 
S/PARMSC/RM , SZM . EMAX » RMAX  »TSC1> ALEPH , TEND 
1/ ALP/ ALPHA » 3 1 pha 1 
C 

LOGICAL  REV, LAST, eflas 
REV  a  .FALSE. 

LAST=  .FALSE, 
pflas  *  .false. 

C 

stop  '  use  tupf.old  as  the  source  for  this  routine' 
TMAXO  a  RMAXtt< 1 ./ALPHA1 ) /ALEPH  +  T01 
TMINO  *  TOL 
130  TMIN  »  TMINO 
TMAX  »  TMAXO 

IF(T01  .LT.  0.)  TMIN  *  0. 

T1  »  (TMAX  +  TMIN)/2. 

r 

DO  100  I  *  1,100 
II  a  0 

110  XG  a  -AFGEN ( RADG , T1 , ' tupf ' ) 

XO  »  XIT(T1,T01) 

IF < XO  .LT.  0.)  GO  TO  120 
T1  =  <Tl+TMIN)/2. 

II  a  II  +  1 

if (pflas)  write( 6,3020)  tl,t01,xs,xo 
5020  for»at( '  ti:',lPSl3.5,'  tOU ' »1fS13.5»  '  xs:',1ps13.5, 

1  '  xo. ' ,1pS13.5) 

IFdI.EQ.  20)  GOTO  101 
30  TO  110 
C 

120  CONTINUE 

DIF  »  XO  -  XG 
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sub  =  (>;o  +  x3)/2. 

IF( ABS(DIF)/ABS(sua)  .LT.  ERTUPF)  GO  TO  1000 
if(pfla3)  urite(A»5040)  tain»taax»tl»xo»xa 
5040  foraatr  tain: ' »1p313.5> '  taax:'»lP3l3.5»'  tlJ ' >1p313.5» 
l  *  xo:'»1ps13.5i'  xa:'»ipsi3.5) 

IF (REV)  GO  TO  140 
IF (DIF  .GT.  0.)  TMAX  *  T1 
IF(DIF  ,LT.  0.)  THIN  =  T1 
GO  TO  100 
C 

140  IF < DIF  .LT.  0.)  TMAX  =  T1 
IF(DIF  .GT.  0.)  THIN  =  T1 
C 

100  T1  =  TMIN  +  0.5*<TMAX-TMIN) 

C 

101  IF( .NOT.  REV)  GO  TO  150 
IF(LAST)  then 

lf(pflad)  urite<6»4000)  RM»SZM»£NAX>RMAX»TSCl»ALEPH>TEND»alPh3 
4000  foraat('  pa:'»lpal3.5»'  sxaJ'flPSlS.Sf'  eaax:  '»1ps13.5»/» 

1  '  rmax: '»1p313.5» '  tsci: ' »1p313.5» '  aleph: ' »1ps13.5>/> 

2  '  tend: ' »1ps13.5» '  ali’haJ '  >1p313.5) 
if(pfla3>  urite(6»4010)  taaxO»tainO 

4010  foraat('  taaxO:  '»1p313.5>'  tainO:  ' »1p313.5) 

CALL  tP3P<6) 

endif 

TMAXO  *  1.13TMAX0 
TMINO  =  0.923TNIN0 
RE1;  =  .FALSE. 

LAST=»TRUE. 
pfla3=. true. 

150  CONTINUE 
tl  =  TL+.01 
T2  =  TL-.01 

XG1  =  AFGEN(RADG>T1» 'tupf ' ) 

;:32  =  AFGEN(RADG»  T2» '  tupf ' ) 
dif  =  3bs(;:3l-::32) 

if (dif .3t.  100.  .AND.  (X0.GE.XG2  .AND.  XO.LE.XGD)  then 

tupf  *  t2  !  JUMP  FROM  BLANKET  TO  NOBLANKET 

RETURN 

ENDIF 

REV  =  .TRUE. 

GO  TO  130 
C 

1000  TUPF  =  Tl 

IF (REV)  URlTE(lunlo3»1100) 

1100  FORMAT ( IX » ' ?TUPF?  --  REV  WAS  TRUE  --  '»49X»'Z'> 

RETURN 

END 

C 

FUNCTION  TDNF(TOl) 

U 


sasldeaadis: TUPF . FOR 


Implicit  Re»l*8  (  A-H»  0-Z  )»  Inte*er*4  (  I-N  ) 


include  's*s$deS3distDEGADIS2.dac' 

COMMON 

I/GEN3/  P3dd(2»Mxl)»Qstr<2»Mxl)>sped»n(2»Mxl)»srcwc(2»«sxl) » 
I  *rcM«(2»e«xl) »srctnth(2»e«xl) 

S/ERROR/S YOER t ERRO t  SZOER  t  HT AIO » UTQOO t UTSZO  t  ERRP  t SMXP » 
t  WTSZP t WTSYP f  WTBEP t WTDH t ERRO t SMXG  t  ERTDNF t ERTUPF  *  WTRUH > WTDH6 
S/PARMSC/RM » SZMt  EMAX t RMAX » TSC1 » ALEPHt  TEND 
l/ALP/ ALPHA t alphal 

LOGICAL  REVtLAST»Pfl3d 
REV  =  .FALSE. 

LAST*  .FALSE, 
pflss  *  .false. 

TMINO  *  RMAX»<  1  ./ALPHA1  l/ALEPH  +  TOl 
TMAXO  *  <  2 • *RM  AX ) » <  1 . /ALPHA 1 ) / ALEPH  +  TOl 

100  THIN  *  TMINO 
TMAX  *  TMAXO 

IF<TMIN  .LT.  0.)  TMIN  *  0. 

T  *  <TMAX  f  TMIN)/2. 

DO  110  I  *  ItlOO 
II  *  0 

120  XG  *  AFGEN ( RADG tit' tdnf ' ) 

XO  *  XIT(Tt TOl) 

IF(XO  .GT.  0.)  GO  TO  130 
T  •••  (TMAX  +  T)/2. 

II  *  II  *  1 

iflpflaa)  wpite<6t3020)  t»t01»xs»xo 
3020  for»at( '  t:'»lMl3.5f'  tOl: ' t >Sl3.3t '  x*{'tlMl3.5t 
1  '  xol'tlM  13.3) 

IF(II.EQ.  20)  GOTO  111 
30  TO  120 
130  CONTINUE 

DIF  *  XO  -  XG 
sue  *  ;:o+xs 

IF < ABS < DIF )/abs( sue)  .LT.  ERTDNF)  GO  TO  1000 
if (pf las)  write(A*3040>  tain»taaxtttxorxs 
3040  foraatC'  tain) ' >lf»il3.5t '  taaxl ' »l>*13.3t '  t: ' »lMl3.3t 
1  '  xo."tlP«13.3t'  x3:'tlPSl3.S) 

IF (REV)  GO  TO  140 

IF < DIF  .GT .  0.)  TMAX  *  T 

IFCDIF  .LT.  0.)  TMIN  *  T 
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140  IF < DIF  .LT.  0.)  TNAX  *  T 
IFCDIF  .GT.  0.)  THIN  *  T 
C 

110  T  a  THIN  *  0.5*<THAX  -  THIN) 

C 

111  IF< .NOT .  REV)  GO  TO  130 
IF (LAST)  then 

if (pflaa)  write(6»4000)  RH t SZM » EMAX » RMAX t TSCl » ALEPH t TEND » alpha 
4000  for«at('  rel '  #1M13.5» '  sz»: ' »lPdt3.3» '  ».*eax :  '»lpal3.5»/» 

1  '  reax:'»lpsl3.3>'  tsci:Mj»el3.5»'  3leFh:',lMl3.5f/» 

2  '  tend: '»lpal3.5» '  al;‘ha:'#lp«13.3) 
if(pflaa)  write(6?4010)  taaxOrteinO 

4010  for»at('  taaxOt  '*1p413.5»'  tainO:  ' rlMl3.S) 

CALL  trap < 7) 

•ndif 

TMAXO  »  l.ltTMAXO 
TNINO  *  0.?2*TNINO 
REV  *  .FALSE. 

LAST*. TRUE, 
fit  lad  *  .true. 

GOTO  100 
C 

150  CONTINUE 
tl  *  Tf ,01 
T2  a  T-.01 

XG1  *  AFGEN(RADG»Tl,'tdnf') 

:;*2  *  AFGEN(RAOG» T2» 'tdnf ' ) 
dif  *  3bs(;:sl-xd2) 

ircdif.at.  100.  .AND.  (X0.LE.XG2  .AND.  X0.6E.XG1) )  then 

tdnf  »  t2  !  JUMP  FROH  BLANKET  TO  NOBLANKET 

RETURN 

ENDIF 

REV  a  .TRUE. 

GO  TO  100 
1000  TDNF  »  r 

IF (REV)  WRITE (lunloe» 1100) 

1100  FORMAT (5X,'?TDNF?  —  REV  WAS  TRUE' »4?X» 'X' ) 

RETURN 

END 

#♦#* 


1  --  »tfs$deSadis:TUPF .FOR 


ooooooo  o  o  n  nnnnnnn  no  ooooooo 


FUNCTIONS  ASSOCIATED  WITH  THE  OBSERVER  CALCULATIONS 


t 

FUNCTION  TO  RETURN  OBSERVER  VELOCITY  AS  A  FUNCTION  OF  TIME 
FUNCTION  UIT<T»T01) 


Implicit  Real <8  (  A-H>  0-Z  )»  Intea#r«4  (  I-N  ) 
COMMON 

I /P ARMSC/RM » SZM » EMAX • RMAX » TSC1 » ALEPH » TEND 
4/Al.P/ALPHA  f  a lehal 

UIT  »  ALPHA1  *  ALEPHWALPHAl  «T-T01)«ALPHA 

RETURN 

END 


FUNCTION  TO  RETURN  POSITION  AS  A  FUNCTION  OF  TIME  AND  TO 


FUNCTION  XIT(T1*T01) 


Illicit  R*al<8  <  A-H,  0-Z  )»  InteStr*4  (  I-N  ) 
COMMON 

S/PARMSC/RN » SZM » EMAX » RMAX  t TSC1 » ALEPH  *  TEND 
*/ ALP/ ALPHA » alpha 1 

xit  3  -raax 

ars  3  tl-tOl 

if (ars  .  le.  0.)  ratum 

XIT  3  <ALEPH<<T1  -  T01))«ALPHA1  -  RMAX 

RETURN 

END 


FUNC  TO  RETURN  A  VALUE  OF  TO  BASED  ON  A  POSITION  AND  TIME 
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FUNCTION  T008(X#T) 

C 

Illicit  RffilfS  (  A-H»  O-Z  )»  Int«Str*4  <  I-N  ) 

CONNON 

4/PARHSC/RH » SZN  i EMAX » RMAX » TSC1 » ALEPH*  TEND 
t/ ALP/ ALPHA  t alpha 1 
C 

ARG  ■  0. 

CHECK  *  ABS< (ABS(X)-ABS(RNAX) ) )/(ABS(X)+ABS(RNAX) > 

IF (CHECK  .GT.  0.001)  ARG  *  (X  +  RHAX)«<1./ALPHA1>/ ALEPH 

TOOB  *  T  -  ARG 

RETURN 

END 

»*** 


2  —  susMaSadisJUIT.FOR 


i 
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APPENDIX  D 

ERROR  MESSAGES 


To  assise  ehe  user  in  determining  the  source  of  any 
problems,  a  diagnostic  procedure  has  been  included  in  DEGADIS. 
The  subroutine  TRAP  is  meant  to  cause  an  orderly  termination  of 
the  program  for  many  detected  errors.  It  performs  two  basic 
functions :  TRAP  displays  an  error  coda  and  a  single  line 
diagnostic  massage  giving  the  reason  for  premature  termination, 
and  TRAP  forces  an  output  of  the  COMMON  area  data  sets  to  the 
file  TRAP. DBG. 

The  first  three  lines  sent  to  the  execution  log 
(default-TERMINAL)  include  the  TRAP  Introductory  lines  and  the 
error  coda  number: 

The  best  laid  plans  of  mice  and  man  .  .  . 

You  have  entered  a  TRAP- -THE  LAND  OF  NO  RETURN 

CODE:  NN 

where  NN  represents  the  coda  of  the  error  message  which  follows 
in  the  log.  The  error  message  begins  with  the  name  of  the 
calling  routine. 

The  following  is  a  list  of  the  error  codes,  error  messages, 
and  suggested  actions  for  each  problem. 


Code:  1 

DEGADIS1?  Source  integration  has  returned  IHLF-NN 

Action:  This  error  occurs  during  integration  of  the  equations 
describing  the  gas  source.  NN  is  an  error  code  returned  by  the 
Integration  package  RKGST. 


When  NN-11,  more  Chen  10  bleectlone  of  Che  iniciel 
Increment  of  che  independent  variable  were  necessary  Co  Cake  an 
integration  step  within  che  specified  error.  Reduce  the 
initial  step  size  of  the  independent  variable  (ER1  file) .  If 
this  does  not  work,  it  will  be  necessary  to  either  increase  the 
error  criteria  for  all  of  che  dependant  variables  being 
integrated  (ER1  file)  or  increase  the  error  criteria  for  the 
variable  violating  the  criteria  by  decreasing  the  error  weight 
for  that  variable  (ER1  file) . 

When  NN-12,  che  initial  increment  of  the  independent 
variable  is  0.  Correct  the  ER1  file  and  execute  the  program 
again. 

When  NN-13 ,  che  initial  increment  of  the  independent 
variable  is  not  che  same  sign  as  the  difference  between  the 
upper  bound  of  the  interval  end  the  lower  bound  of  the 
interval.  Correct  the  ESI  file  and  execute  che  program  again. 

Coda :  2 

Reserved 

Action:  Not  applicable 

Code:  3 

SZF?  Local  integration  failed;  IHLF-NN 

Action:  This  error  occurs  during  estimation  of  che  value  of  S 

2 

over  the  source  when  no  gas  blanket  is  present.  See  Code:  1 
for  appropriate  actions. 


Coda:  4 

SURFACE?  Negative  QRTE  for  positive  DELTA_T 

Action:  Diagnostic  aassaga  indicating  an  error  in  estimation 
of  the  heat  capacity. 

Code:  5 

CRFG?  More  points  for  GEN3  were  needed 

Action:  The  COMMON  area  /GEN3/  stores  representative  values  of 
che  calculated  source  parameters.  If  this  condition  occurs, 
relax  the  CRFG  error  criteria  in  the  ER2  file.  If  this  is  a 
common  problem,  Che  length  of  che  /GEN3/  vectors  can  be 
increased  by  changing  Che  value  of  MAXL  in  DEGADIS1.DEC  and 
reinstalling  DEGADIS . 

Coda:  6 

TUPF?  Observer  calculations ••TUFF  failed 

Action:  The  trial  and  error  search  associated  with  finding  the 
upwind  edge  of  che  gas  source  for  an  observer  failed.  Often 
this  problem  can  be  avoided  by  adding  one  or  two  additional 
observers  to  che  present  number  of  observers  (which  moves  the 
solution  of  the  trial  and  error) .  Another  possibility  is  to 
increase  the  error  criteria  for  this  function  in  the  ER2  file. 


Code:  7 

TUPF?  Observer  calculations --TDNF  failed 

Action:  The  trial  and  error  search  associated  with  finding  the 
downwind  edge  of  the  gas  source  for  an  observer  failed.  Often 
this  problea  can  be  avoided  by  adding  one  or  two  additional 
observers  to  the  present  number  of  observers  (which  moves  the 
solution  of  the  trial  and  error) .  Another  possibility  is  to 
increase  the  error  criteria  for  this  function  in  the  ER2  file. 

Code:  8 

SSSXJP?  Observer  integration  failed;  IHLF-NN 

Action:  This  error  occurs  during  Integration  of  the  four 
differential  equations  which  average  the  source  for  each 
observer.  See  Coda:  1  for  appropriate  actions. 

Code:  9 

SSSUP/SDEGADIS2?  Pseudo-Steady  integration  failed,  IHLF-NN 

Action:  This  error  occurs  during  integration  of  the  four 
differential  equations  describing  the  portion  of  the  downwind 
calculation  when  b  >  0.  The  routine  calling  TRAP  is  SSSUP  if  a 
transient  simulation  is  being  executed;  if  a  steady  state 
simulation  is  being  executed,  the  calling  routine  is  SDEGADIS2 . 
See  Code:  1  for  appropriate  actions. 
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Coda:  10 

SSSU?/SDEGADIS2?  Gaussian  integration  failed,  IHLF-NN 

Action:  This  error  occurs  during  integration  of  the 
differential  equations  which  describe  the  portion  of  the 
downwind  calculation  when  b  -  0.  The  routine  calling  TRAP  is 
SSSTJP  if  a  transient  sinulation  is  being  executed;  SDEGADIS2  is 
calling  TRAP  if  a  steady  state  sinulation  is  being  executed. 

See  Code:  1  for  appropriate  actions. 


Code:  11 

SSSUP/SDEGADIS2?  TOTAL  NO.  OF  RECORDS  EXCEEDS  120,000 

Action:  This  is  an  arbitrary  stopping  point  for  the  process  in 
order  to  keep  a  runaway  sinulation  from  filling  up  disk  space. 
Relax  the  output  specifications  in  the  ER2  file  in  order  to 
generate  less  output. 


Code :  12 

Reserved 

Action:  Not  applicable 


Code:  13 
Reserved 

Action;  Not  applicable 


Coda :  14 

Reserved 


Action:  Mot  applicable 

Coda:  15 
Reserved 


Action :  Not  applicable 

Coda:  16 

PSSOUT/PSSOUTSS?  PSS  started  with  b  <  0 

Action:  This  condition  is  checked  at  the  beginning  of  the 
downwind  calculation  in  order  to  confins  proper  handling  of  the 
movement  to  the  Gaussian  phase  of  the  downwind  calculation. 
Correct  the  initial  conditions  and  execute  the  program  again. 


$ 


i 


Code:  17 

TPROP/ADDHEAT?  Enthalpy  out  of  bounds 

Action:  Diagnostic  message  indicating  an  enthalpy  lower  than 
the  adiabatic  mixing  enthalpy  was  passed  to  ADDKEAT. 


wmmrmmmw 
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Coda :  18 

ALFH?  ALPHA  integration  failed;  IHLF-NN 

Action;  The  integration  which  determines  the  integral  least 
squares  fit  for  ALPHA  has  failed.  See  Code:  1  for  appropriate 
actions.  Note  that  large  values  of  Monin -Obukhov  length  (A  > 
0(1.0  m))  in  combination  with  stable  atmospheric  conditions  may 
cause  this  Integration  to  fail. 

Code:  19 

ALPH?  RTMI  has  failed  to  locate  ALPHA;  IERR:  NN 

Action:  The  search  procedure  to  determine  the  value  of  ALPHA 
has  failed.  NN  is  an  error  code  returned  by  the  routine  RTMI. 

When  NN-1,  the  search  for  ALPHA  failed  after  a  specified 
number  of  iterations. 

When  NN— 2 ,  the  basic  assumption  that  the  function  which 
governs  the  search  for  ALPHA  changes  sign  over  the  specified 
interval  is  falsa. 

This  error  is  probably  t:he  result  of  an  unusual  velocity 
specification  such  as  small  values  for  the  Monln-Obukhov  length 
(A  <  0(1.0  m))  or  small  values  for  the  reference  height  (zQ  < 
0(10A) ) .  Also  see  Code:  18. 

20 

ESTRT?  Premature  EOF  in  RUN_NAME .  ER1  or  RUN_NAME .  ER2 . 

Action:  The  portion  of  the  program  which  reads  ER1  and  ER2 
files  encountered  an  end-of-file  before  all  of  the  information 
had  been  gathered.  Confirm  these  files  and  execute  the  program 
again.  If  necessary,  copy  and  edit  an  EXAMPLE  file  for  your 
application  and  execute  the  program  again. 


Coda:  21 

ESTRT1/ESTRT2/ESTRT2SS/ESTRT3?  DECODE  failed 

Action:  The  portion  of  the  program  which  reads  the  E&l,  ER2 , 
or  E&3  file  failed  to  understand  a  numerical  entry.  The 
numbers  must  appear  in  columns  11-20  of  the  line  with  no 
alphabetic  characters  in  the  field.  This  does  not  apply  to 
comment  lines  which  contain  an  exclamation  point  (!)  in  the 
first  column  of  the  line. 

Code:  22 

ESTRT1?  The  parameter  file  RUNNAME . EB1  was  not  found 

Action:  The  ER1  file  was  not  found  for  the  current  simulation 
(RUNNAME).  Copy  the  EXAMPLE. ER1  file  to  RUNNAME . ER1  and  edit 
it  as  necessary.  Execute  the  program  again. 

Code:  23 

SORTS1?  Fewer  than  3  points  sorted  for  any  time 

Action:  Only  one  or  two  simulation  points  were  applicable  for 
the  sort  times  specified.  There  are  two  possible  causes  for 
this  condition:  First,  sort  times  specified  were  either  before 
the  simulation  had  developed  significantly,  or  after  the 
simulation  was  completed.  If  additional  information  is  desired 
at  the  end  of  the  simulation,  restart  the  simulation  and 
specify  a  lower  concentration  of  interest  in  the  input  step 
(DEGADISIN) .  Second,  the  number  of  observers  specified  for  the 
problem  was  too  low  to  give  a  good  resolution  of  the  downwind 
concentration  field.  Increase  the  number  of  observers  in  the 


Code :  24 

TPROP?  Trial  and  error  loop  compromised 

Action:  TFROP  estimates  the  temperature  of  a  mixture  based 
upon  the  composition  and  enthalpy  of  the  mixture .  Ensure  the 
properties  for  the  diffusing  species  are  entered  correctly  and 
execute  the  simulation  again. 

Code:  25 
Reserved 

Action:  Not  applicable 

Code:  26 

TFROP?  Invalid  entry  flag  in  ADIABAT 

Action:  This  is  a  programming  diagnostic.  This  error  should 
never  occur . 

Code:  27 

Reserved 


Action:  Not  applicable 
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Code:  28 

T?ROP?  IGEN  request  too  large  in  SETDEN 

Action:  The  subroutine  SETDEN  performs  a  series  of  adiabatic 
mixing  calculations  with  a  specified  gas  mixture  and  ambient 
air  and  places  the  results  in  the  array  DEN (5, IGEN).  This 
error  indicates  more  points  are  needed  in  DEN  than  were 
originally  requested.  Increase  the  allocation  for  DEN  by 
changing  the  value  of  IGEN  in  DEGADISIN.DEC  and  reinstalling 
DEGADIS . 

Code:  29 

PHIF?  flag  out  of  bounds 

Action:  This  is  programming  diagnostic.  This  error  should 
never  occur. 

Code :  30 

SSSUP/SDEGADIS2?  concentration  greater  than  RHOE 

Action:  If  the  concentration  of  the  contaminant  becomes 
greater  than  the  pure  component  density  for  an  isothermal 
simulation,  this  error  will  occur.  However,  this  situation 
should  never  occur. 

Code:  31 

Reserved 


Action:  Not  applicable 


Code:  32 

FSS?  Sz  convergence  failure 


Action:  This  is  a  programming  diagnostic.  This  error  should 
never  occur. 


Code :  33 

SSG?  Sz  convergence  failure 

Action:  This  is  a  programming  diagnostic.  This  error  should 


never  occur. 


APPENDIX  E 


PARTIAL  LISTING  OF  PROGRAM  VARIABLES 


ggclahlft 

gflCd.lYPO 

Symbol 

Units 

fiflnaansi 

AGAIN 

LOGICAL 

Local 

coomunlcaclons 
in  SSSUP 

ALEPH 

REAL 

Collaction  of 
constants  to 
calculate 
observer 
position  and 
velocity 

ALPHA 

REAL 

a 

n/a 

Power  law 
velocity 
profile  power 

ALPHA1 

REAL 

<1.0  +  a) 

n/a 

BETA 

REAL 

P 

n/a 

Lateral 

similarity 

power 

CCLOW 

REAL 

kg/m3 

Lowest  mixture 
concentration 
of  interest 

CHECK1 

LOGICAL 

Unused  logical 
flag 

CHECK2 

LOGICAL 

When  true, 
release  type 
without  a 
liquid  source 

CHECK3 

LOGICAL 

Local 

communications 
flag  used  in 
DEGADIS1 

E-2 


Variable 

Data  Tvoe 

Sywhol 

Units 

CopminM 

CHECK4 

LOGICAL 

Whan  true, 
steady  state 

release 

CHECK5 

LOGICAL 

When  true,  user 
sets  tiae  sort 
paraoeters 

DELIA 

REAL 

S 

-1* 

Lateral 

siailarity 

coefficient 

DEN(l.I) 

REAL 

*C 

oola 

fraction 

Contaminant 
aole  fraction 

DEN(2,I) 

REAL 

e 

c 

kg/*3 

Contaminant 
concentration 
for  the  given 
oola  fraction 

DEN(3 , I) 

REAL 

kg/*3 

Mixture  density 
for  the  given 
■ole  fraction 

DEN(4, I) 

REAL 

h 

JAg 

Mixture 
enthalpy  for 
the  given  mole 
fraction 

DEN(5 , I) 

REAL 

T 

K 

Mixture 

temperature  for 
the  given  sole 
fraction 

EMAX 

REAL 

kg/s 

Maximum  of 
secondary 
source  oass 
evolution  rate 

ESS 

REAL 

E 

kg/s 

Steady  state 

release  rate 

ET(1, I) 

REAL 

t 

s 

Independent 
variable  time 
for  ordered 
pairs  ET 

* 


V-  *>;* 


Variable 

Data  Type 

Symbol 

Units 

Comments 

ET(2,I) 

REAL 

E(t) 

kg/s 

Source  mass 
evolution  rate 
as  a  function 
of  time 
characterized 
by  ordered 
pairs 

G 

REAL 

S 

.  2 

m/s 

Acceleration 
due  to  gravity 

GAMMAF 

REAL 

ra/u-k*)) 

n/a 

GAS_CPK 

REAL 

qi 

J/laaol 

Constant  for 
contaminant 
heat  capacity 

GAS_CPP 

REAL 

Pi 

n/a 

Power  for 
contaminant 
heat  capacity 

GAS_LFL 

REAL 

mole 

fraction 

Lower 

flammability 
limit  of 
contaminant 

GAS_MW 

REAL 

M»c 

kg/lcmol 

Contaminant 

molecular 

weight 

GAS_NAME 

CHARACTER* 3 

Name  of 
contaminant 

GAS_RHOE 

REAL 

po 

kg/m3 

Saturated  vapor 
density  of 
contaminant  at 

To 

GAS_TEMP 

REAL 

To 

K 

Contaminant 

storage 

temperature 

GASJTFL 

REAL 

mole 

fraction 

Upper 

flammability 
limit  of 
contaminant 

Variable 

Data  Tvna 

Svnbol  Units 

Comments 

GAS_ZSP 

REAL 

a 

Haight  for 
estimating 
flammability 
contours 

GMASSO 

REAL 

leg 

Initial  aass  of 
gas  over  the 
primary  source 

HTCO 

REAL 

hQ  J/a2sK 

vH  ./. 

Constant 
coafficiant 
whan  IHTFL— 1 
LLNL  heat 
transfer 
velocity  whan 
IHTFL-2 

HUMID 

REAL 

kg  water/ 
kg  dry  air 

Ambient 

absolute 

humidity 

IHTFL 

INTEGER 

Heat  transfer 
flag: 

IHTFL— 1  constant  coefficient 
IHTFL-0  no  heat  transfer 

IHTTL-1  DEGADIS  coafficiant 

IHTFL-2  LLNL  coafficiant 

ISOFL  INTEGER  Iaotharmal 

ralaaaa  whan 

ISOFL-l 

ISTAB  INTEGER  Paaquill 

atmospheric 
stability 
Indicator 
(ISTAB-1  for  A, 

(ISTAB~2  for  B,  ate.) 

IWTFL  INTEGER  Water  transfer 

flag 

IWTFL- -1  constant  coafficiant 
IWTFL— 0  no  water  transfer 

IWTFb-l  DECADIS  coafficiant 


Variable 

Data  Tyv9 

Symbol 

Units 

Comments 

K 

REAL 

k 

n/a 

von  Kerman*  s 
constant  0.35 

LUNLQG 

INTEGER 

Fortran  logical 
unit  number 
which  acts  as  a 
simulation  log 

MAXNOB 

INTEGER 

Maximum  number 
of  observers 

ML 

REAL 

X 

a 

Monin*  Obukhov 
length 

NOBS 

INTEGER 

Number  of 
observers  for 
the  pseudo - 
steady  state 
simulation 

NREC(1,1) 

INTEGER 

Number  of 
records 
generated  in 
PSSOUT  for 
observer  I 

NREC(I,2) 

INTEGER 

Number  of 
records 
generated  in 
SSGOUT  for 
observer  I 

PAMB 

REAL 

P 

atm 

Ambient 

pressure 

POUND 

CHARACTERS 

Character 
string  to 
signal  end  of 

data  ('//  ') 

POUNDN 

REAL 

Numerical  value 
to  signal  end 
of  data 
(-1.E-20) 

Variable 

Data  Type 

Symbol 

Units 

QSTR(1,I) 

REAL 

t 

s 

Independent 
variable  time 
for  ordered 
pairs  QSTR 

QSTR(2,I) 

REAL 

Q* 

kg/a2s 

Atmospheric 
take up  rate  as 
a  function  of 

tine 

RADG(1, I) 

REAL 

t 

s 

Independent 
variable  time 
for  ordered 
pairs  RADG 

RADG(2, I) 

REAL 

R 

a 

Secondary 
source  radius 
as  a  function 
of  time 

RELHTJMID 

REAL 

% 

Ambient 

relative 

humidity 

RHOA 

REAL 

'a 

kg/a3 

Ambient  air 
density 

RM 

REAL 

R 

■ 

a 

Radius  at  EMAX 
(when  secondary 
source  mass 
evolution  rate 
is  a  maximum) 

RMAX 

REAL 

R 

max 

a 

Maximum 
secondary 
source  radius 

RT2 

REAL 

n/a 

Constant 

R1SS 

REAL 

R 

P 

a 

Steady  state 
primary  source 
radius 

R1T(1,I) 

REAL 

t 

s 

Independent 
variable  time 
for  ordered 
pairs  R1T 

E-7 


Variable 

Data  Tvoe 

Symbol  Units 

R  a 

R1T(2,I) 

REAL 

Primary  source 

P 

radius  as  a 

function  of 

time 

characterized 
by  ordered 
pairs 


SIGX_COEFF 

REAL 

Along *wind 
similarity 
coefficient 

S I  GX_MIN_D  1ST 

REAL 

a 

Minimum 
distance  to 
apply  along - 
wind  dispersion 
correction 

SIGX_POW 

REAL 

n/a 

Along-vind 

similarity 

power 

SLEN 

REAL 

L 

a 

Scaady  state 
source  length 

SQPI02 

REAL 

J*/2. 

n/a 

Constant 

SQRTPI 

REAL 

yr 

Constant 

SRCDEN(l.I) 

REAL 

t 

s 

Independent 
variable  time 
for  ordered 
pairs  SRCDEN 

SRCDEN(2, I) 

REAL 

p 

kg/a3 

Secondary 
source  density 
as  a  function 
of  time 

SRCENTH(l.I) 

REAL 

t 

s 

Independent 
variable  time 
for  ordered 
pairs  SRCENTH 

gflXlafelfl  Data  Tyga  Symbol  Units 


Comments 


SRCENTH(2, I) 

REAL 

h 

JAg 

Secondary 
source  enthalpy 
as  a  function 
of  tine 

SRCWA(l.I) 

SEAL 

t 

s 

Independent 
variable  tlae 
for  ordered 
pairs  SRCUA 

SRCWA(2 , I) 

REAL 

w 

a 

mass 

fraction 

Secondary 
source  air  aass 
fraction  as  a 
function  of 
tine 

SRCWC(l.I) 

REAL 

c 

s 

Independent 
variable  time 
for  ordered 
pairs  SRCVC 

SRCWC(2,I) 

REAL 

w 

e 

mass 

fraction 

Secondary 

source 

contaminant 
aass  fraction 
as  a  function 
of  time 

SWID 

REAL 

a 

Steady  state 
source  width 

SZM 

REAL 

^zOa 

a 

Value  of  S  .  at 
EMAX  (when* 
secondary 
source  aass 
evolution  rate 
is  a  maximum) 

TAMB 

REAL 

T 

K 

Ambient 

temperature 

TEND 

REAL 

s 

Termination 
tiae  of 
secondary 
source 

■E-9 


Variable 

Data  Type 

Symbol 

Units 

Comments 

TINP 

CHARACTER* 2 4 

Time  DEGADISIN 
was  executed 

TITLE(1:4) 

CHARACTER*8  0 

Text  title 
bloclc  4  lines 
of  30  spaces 

TO  (I) 

REAL 

s 

Time  of  release 
for  observer  I 

TStTRJc 

REAL 

T 

s 

K 

Surface 

temperature 

USTAR 

REAL 

u* 

m/s 

Friction 

velocity 

00 

REAL 

U0 

m/s 

Ambient 
velocity  at 
height  zQ 

WTCO 

REAL 

2 

F  kmol/m  sata 

Hass  transfer 
coefficient 
when  IWTFL— 1 

XV(I) 

REAL 

*v 

m 

Virtual  source 
position  for 
estimation  of 

S  in  SSG 

7 

20 

REAL 

Z0 

m 

Height  for 
velocity  uQ 

ZR 

REAL 

*R 

m 

Roughness 

length 

